31 Commits
0.7.0 ... 0.7.3

Author SHA1 Message Date
641e23c3ef Release 0.7.3 2016-05-30 17:16:37 +02:00
82ea75cc88 Small documentation fix 2016-05-30 17:16:24 +02:00
abf043be14 Add examples to README 2016-05-30 16:02:08 +02:00
10adc4be27 TRAVIS: use CABALVER=1.24 for GHCVER=7.10.2 2016-05-30 13:33:22 +02:00
a176e4970b TRAVIS: add CABALVER=1.24 GHCVER=8.0.1 2016-05-30 13:32:56 +02:00
08de2ebefb Move RelC class from HPath.Internal to HPath 2016-05-30 13:02:34 +02:00
d15d7761c1 Don't expose HPath.Internal 2016-05-30 13:01:47 +02:00
7e924d3386 Remove benchmarks
We don't really need this.
2016-05-29 22:45:26 +02:00
21fccc9ca9 Fix build with ghc < 7.10 2016-05-29 18:57:55 +02:00
79dbcd8b55 Add type signature to pattern synonym 2016-05-29 17:56:51 +02:00
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
137 changed files with 1237 additions and 848 deletions

View File

@@ -9,8 +9,10 @@ matrix:
include:
- env: CABALVER=1.22 GHCVER=7.8.4
addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.2
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=7.10.2
addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
- env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}

View File

@@ -1,3 +1,11 @@
0.7.3:
* don't expose HPath.Internal
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:
* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only
* 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
* 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'
* 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,43 @@ so it is forked as well and merged into this library.
## 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`
* 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
## Examples in ghci
Start ghci via `cabal repl`:
```hs
-- enable OverloadedStrings
:set -XOverloadedStrings
-- import HPath.IO
import HPath.IO
-- parse an absolute path
abspath <- parseAbs "/home"
-- parse a relative path (e.g. user users home directory)
relpath <- parseRel "jule"
-- concatenate paths
let newpath = abspath </> relpath
-- get file type
getFileType newpath
-- return all contents of that directory
getDirsFiles newpath
-- return all contents of the parent directory
getDirsFiles (dirname newpath)
```

View File

@@ -1,90 +0,0 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative
import Control.Monad
import System.Directory
import System.FilePath ((</>))
import System.Posix.ByteString.FilePath
import System.Posix.Directory.ByteString as PosixBS
import System.Posix.Directory.Traversals
import qualified System.Posix.FilePath as PosixBS
import System.Posix.Files.ByteString
import Control.Exception
import qualified Data.ByteString.Char8 as BS
import System.Environment (getArgs, withArgs)
import System.IO.Error
import System.IO.Unsafe
import System.Process (system)
import Criterion.Main
-- | Based on code from 'Real World Haskell', at
-- http://book.realworldhaskell.org/read/io-case-study-a-library-for-searching-the-filesystem.html#id620419
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive topdir = do
names <- System.Directory.getDirectoryContents topdir
let properNames = filter (`notElem` [".", ".."]) names
paths <- forM properNames $ \name -> do
let path = topdir </> name
isDir <- doesDirectoryExist path
if isDir
then listFilesRecursive path
else return [path]
return (topdir : concat paths)
----------------------------------------------------------
getDirectoryContentsBS :: RawFilePath -> IO [RawFilePath]
getDirectoryContentsBS path =
modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
(`ioeSetLocation` "getDirectoryContentsBS")) $ do
bracket
(PosixBS.openDirStream path)
PosixBS.closeDirStream
loop
where
loop dirp = do
e <- PosixBS.readDirStream dirp
if BS.null e then return [] else do
es <- loop dirp
return (e:es)
-- | similar to 'listFilesRecursive, but uses RawFilePaths
listFilesRecursiveBS :: RawFilePath -> IO [RawFilePath]
listFilesRecursiveBS topdir = do
names <- getDirectoryContentsBS topdir
let properNames = filter (`notElem` [".", ".."]) names
paths <- forM properNames $ \name -> unsafeInterleaveIO $ do
let path = PosixBS.combine topdir name
isDir <- isDirectory <$> getFileStatus path
if isDir
then listFilesRecursiveBS path
else return [path]
return (topdir : concat paths)
----------------------------------------------------------
benchTraverse :: RawFilePath -> IO ()
benchTraverse = traverseDirectory (\() p -> BS.putStrLn p) ()
main :: IO ()
main = do
args <- getArgs
let (d,otherArgs) = case args of
[] -> ("/usr/local",[])
x:xs -> (x,xs)
withArgs otherArgs $ defaultMain
[ bench "traverse (FilePath)" $ nfIO $ listFilesRecursive d >>= mapM_ putStrLn
, bench "traverse (RawFilePath)" $ nfIO $ listFilesRecursiveBS (BS.pack d) >>= mapM_ BS.putStrLn
, bench "allDirectoryContents" $ nfIO $ allDirectoryContents (BS.pack d) >>= mapM_ BS.putStrLn
, bench "allDirectoryContents'" $ nfIO $ allDirectoryContents' (BS.pack d) >>= mapM_ BS.putStrLn
, bench "traverseDirectory" $ nfIO $ benchTraverse (BS.pack d)
, bench "unix find" $ nfIO $ void $ system ("find " ++ d)
]

View File

@@ -1,5 +1,5 @@
name: hpath
version: 0.7.0
version: 0.7.3
synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood.
license: GPL-2
@@ -12,7 +12,6 @@ build-type: Simple
cabal-version: >=1.14
extra-source-files: README.md
CHANGELOG
benchmarks/*.hs
cbits/dirutils.h
doctests-hpath.hs
doctests-posix.hs
@@ -26,17 +25,17 @@ library
HPath.IO,
HPath.IO.Errors,
HPath.IO.Utils,
HPath.Internal,
System.Posix.Directory.Foreign,
System.Posix.Directory.Traversals,
System.Posix.FD,
System.Posix.FilePath
other-modules: HPath.Internal
build-depends: base >= 4.2 && <5
, bytestring >= 0.9.2.0
, deepseq
, exceptions
, hspec
, simple-sendfile >= 0.2.22
, simple-sendfile >= 0.2.24
, unix >= 2.5
, unix-bytestring
, utf8-string
@@ -73,22 +72,24 @@ test-suite spec
Hs-Source-Dirs: test
Main-Is: Main.hs
other-modules:
Spec
HPath.IO.CopyDirRecursiveSpec
HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyFileSpec
HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec
HPath.IO.CopyFileSpec
HPath.IO.CreateDirSpec
HPath.IO.CreateRegularFileSpec
HPath.IO.CreateSymlinkSpec
HPath.IO.DeleteDirRecursiveSpec
HPath.IO.DeleteDirSpec
HPath.IO.DeleteFileSpec
HPath.IO.GetDirsFilesSpec
HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileSpec
HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec
HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec
Spec
Utils
GHC-Options: -Wall
Build-Depends: base
@@ -98,25 +99,9 @@ test-suite spec
, hspec >= 1.3
, process
, unix
, unix-bytestring
, utf8-string
benchmark bench.hs
default-language: Haskell2010
type: exitcode-stdio-1.0
hs-source-dirs: benchmarks
main-is: Bench.hs
build-depends:
base,
hpath,
bytestring,
unix,
directory >= 1.1 && < 1.3,
filepath >= 1.2 && < 1.5,
process >= 1.0 && < 1.3,
criterion >= 0.6 && < 1.2
ghc-options: -O2
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@@ -24,6 +24,7 @@ module HPath
,Fn
,PathParseException
,PathException
,RelC
-- * PatternSynonyms/ViewPatterns
,pattern Path
-- * Path Parsing
@@ -54,10 +55,10 @@ import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString(ByteString, stripPrefix)
#else
import Data.ByteString(ByteString)
import qualified Data.List as L
#endif
import qualified Data.ByteString as BS
import Data.Data
import qualified Data.List as L
import Data.Maybe
import Data.Word8
import HPath.Internal
@@ -89,12 +90,17 @@ data PathException = RootDirHasNoBasename
deriving (Show,Typeable)
instance Exception PathException
class RelC m
instance RelC Rel
instance RelC Fn
--------------------------------------------------------------------------------
-- PatternSynonyms
#if __GLASGOW_HASKELL__ >= 710
pattern Path :: ByteString -> Path a
#endif
pattern Path x <- (MkPath x)
--------------------------------------------------------------------------------

View File

@@ -56,6 +56,7 @@ module HPath.IO
-- * File creation
, createRegularFile
, createDir
, createSymlink
-- * File renaming/moving
, renameFile
, moveFile
@@ -140,10 +141,7 @@ import System.IO.Error
import System.Linux.Sendfile
(
sendfileFd
)
import Network.Sendfile
(
FileRange(..)
, FileRange(..)
)
import System.Posix.ByteString
(
@@ -318,6 +316,7 @@ copyDirRecursiveOverwrite fromp destdirp
RegularFile -> copyFileOverwrite f newdest
_ -> return ()
-- |Recreate a symlink.
--
-- Throws:
@@ -629,6 +628,20 @@ createDir :: Path Abs -> IO ()
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
-- TODO: make this more robust when destination does not exist
-- |Checks whether the destination directory is contained
-- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories

View File

@@ -3,8 +3,7 @@
-- | Internal types and functions.
module HPath.Internal
(Path(..)
,RelC)
(Path(..))
where
import Control.DeepSeq (NFData (..))
@@ -13,7 +12,7 @@ import Data.Data
-- | Path of some base and type.
--
-- Internally is a string. The string can be of two formats only:
-- Internally is a ByteString. The ByteString can be of two formats only:
--
-- 1. without trailing path separator: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@
-- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@
@@ -23,7 +22,7 @@ import Data.Data
data Path b = MkPath ByteString
deriving (Typeable)
-- | String equality.
-- | ByteString equality.
--
-- The following property holds:
--
@@ -31,7 +30,7 @@ data Path b = MkPath ByteString
instance Eq (Path b) where
(==) (MkPath x) (MkPath y) = x == y
-- | String ordering.
-- | ByteString ordering.
--
-- The following property holds:
--
@@ -39,7 +38,7 @@ instance Eq (Path b) where
instance Ord (Path b) where
compare (MkPath x) (MkPath y) = compare x y
-- | Same as 'Path.toFilePath'.
-- | Same as 'HPath.toFilePath'.
--
-- The following property holds:
--
@@ -50,6 +49,3 @@ instance Show (Path b) where
instance NFData (Path b) where
rnf (MkPath x) = rnf x
class RelC m

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -17,38 +17,47 @@ import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
setupFiles :: IO ()
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 = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.createRegularFile" $ do
-- successes --
it "createRegularFile, all fine" $ do
createRegularFile' (specDir `ba` "newDir")
removeFileIfExists (specDir `ba` "newDir")
createRegularFile' "newDir"
removeFileIfExists "newDir"
-- posix failures --
it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noWritePerms/newDir")
createRegularFile' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noPerms/newDir")
createRegularFile' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, destination file already exists" $
createRegularFile' (specDir `ba` "alreadyExists")
createRegularFile' "alreadyExists"
`shouldThrow`
(\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)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
setupFiles :: IO ()
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
specDir' = toString specDir
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "file"
deleteFile' "dir/.keep"
deleteDir' "dir"
deleteFile' "dirSym"
deleteFile' "noPerms/.keep"
deleteDir' "noPerms"
deleteFile' "noWritable/.keep"
deleteDir' "noWritable"
spec :: Spec
spec =
spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.deleteDirRecursive" $ do
-- successes --
it "deleteDirRecursive, empty directory, all fine" $ do
createDir' (specDir `ba` "testDir")
deleteDirRecursive' (specDir `ba` "testDir")
getSymbolicLinkStatus (specDir `ba` "testDir")
createDir' "testDir"
deleteDirRecursive' "testDir"
getSymbolicLinkStatus "testDir"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
createDir' (specDir `ba` "noPerms/testDir")
noPerms (specDir `ba` "noPerms/testDir")
deleteDirRecursive' (specDir `ba` "noPerms/testDir")
createDir' "noPerms/testDir"
noPerms "noPerms/testDir"
deleteDirRecursive' "noPerms/testDir"
it "deleteDirRecursive, non-empty directory, all fine" $ do
createDir' (specDir `ba` "nonEmpty")
createDir' (specDir `ba` "nonEmpty/dir1")
createDir' (specDir `ba` "nonEmpty/dir2")
createDir' (specDir `ba` "nonEmpty/dir2/dir3")
createRegularFile' (specDir `ba` "nonEmpty/file1")
createRegularFile' (specDir `ba` "nonEmpty/dir1/file2")
deleteDirRecursive' (specDir `ba` "nonEmpty")
getSymbolicLinkStatus (specDir `ba` "nonEmpty")
createDir' "nonEmpty"
createDir' "nonEmpty/dir1"
createDir' "nonEmpty/dir2"
createDir' "nonEmpty/dir2/dir3"
createRegularFile' "nonEmpty/file1"
createRegularFile' "nonEmpty/dir1/file2"
deleteDirRecursive' "nonEmpty"
getSymbolicLinkStatus "nonEmpty"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteDirRecursive, can't open parent directory" $ do
createDir' (specDir `ba` "noPerms/foo")
noPerms (specDir `ba` "noPerms")
(deleteDirRecursive' (specDir `ba` "noPerms/foo")
createDir' "noPerms/foo"
noPerms "noPerms"
(deleteDirRecursive' "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
>> normalDirPerms (specDir `ba` "noPerms")
>> deleteDir' (specDir `ba` "noPerms/foo")
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noPerms"
deleteDir' "noPerms/foo"
it "deleteDirRecursive, can't write to parent directory" $ do
createDir' (specDir `ba` "noWritable/foo")
noWritableDirPerms (specDir `ba` "noWritable")
(deleteDirRecursive' (specDir `ba` "noWritable/foo")
createDir' "noWritable/foo"
noWritableDirPerms "noWritable"
(deleteDirRecursive' "noWritable/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
normalDirPerms (specDir `ba` "noWritable")
deleteDir' (specDir `ba` "noWritable/foo")
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noWritable"
deleteDir' "noWritable/foo"
it "deleteDirRecursive, wrong file type (symlink to directory)" $
deleteDirRecursive' (specDir `ba` "dirSym")
deleteDirRecursive' "dirSym"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, wrong file type (regular file)" $
deleteDirRecursive' (specDir `ba` "file")
deleteDirRecursive' "file"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, directory does not exist" $
deleteDirRecursive' (specDir `ba` "doesNotExist")
deleteDirRecursive' "doesNotExist"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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