46 Commits
0.6.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
908513da2b Prettify doctests 2016-05-23 00:52:27 +02:00
47dd729e8a Small documentation improvements 2016-05-22 13:41:39 +02:00
620550dab4 Minor documentation fixes 2016-05-22 13:28:20 +02:00
ebab5355bc Beautify 2016-05-19 01:29:08 +02:00
8fdf1bf956 Add gitter link 2016-05-19 01:28:11 +02:00
39913faed6 Add hackage icon to README 2016-05-18 15:58:28 +02:00
5ed249f5d6 Fix haddock 2016-05-18 14:03:50 +02:00
a8ccfc2587 Release 0.7.0 2016-05-18 14:02:08 +02:00
8fec862304 Rm redundant import 2016-05-18 13:48:38 +02:00
646fe7cfea Doc update 2016-05-18 13:42:31 +02:00
1bf27258c1 Uhm 2016-05-18 13:33:17 +02:00
797dcaf725 Backport changes from posix-paths PR:
* add isFileName
* add hasParentDir
* add hiddenFile
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* fix linting warnings
* lift version constraints in benchmark

Also adjust HPath.IO to work with the new API.
2016-05-18 04:11:40 +02:00
0fa66cd581 Use sendfile for copying and read/write as fallback 2016-05-18 03:47:39 +02:00
ee3ace362b HPath.IO: minor doc fix 2016-05-10 12:05:55 +02:00
05fcad14f1 HPath.IO.Errors: minor documentation fix 2016-05-10 02:02:05 +02:00
139 changed files with 1550 additions and 1075 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,19 @@
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
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* lift version constraints in benchmark
* remove fpToString and userStringToFP, use Data.ByteString.UTF8 directly instead
0.6.0:
* fixes 'throwDestinationInSource' to be more reliable.
* removes some unused HPathIOException constructors

View File

@@ -1,6 +1,6 @@
# HPath
[![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath)
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath)
Support for well-typed paths in Haskell. Also provides ByteString based filepath
manipulation.
@@ -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.6.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,15 +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.24
, unix >= 2.5
, unix-bytestring
, utf8-string
@@ -71,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
@@ -96,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.4,
process >= 1.0 && < 1.3,
criterion >= 0.6 && < 0.9
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
@@ -45,9 +46,6 @@ module HPath
,withAbsPath
,withRelPath
,withFnPath
-- * ByteString operations
,fpToString
,userStringToFP
)
where
@@ -57,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
@@ -92,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)
--------------------------------------------------------------------------------
@@ -109,19 +112,19 @@ pattern Path x <- (MkPath x)
--
-- Throws: 'PathParseException'
--
-- >>> parseAbs "/abc" :: Maybe (Path Abs)
-- >>> parseAbs "/abc" :: Maybe (Path Abs)
-- Just "/abc"
-- >>> parseAbs "/" :: Maybe (Path Abs)
-- >>> parseAbs "/" :: Maybe (Path Abs)
-- Just "/"
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
-- Just "/abc/def"
-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)
-- Just "/abc/def/"
-- >>> parseAbs "abc" :: Maybe (Path Abs)
-- >>> parseAbs "abc" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "" :: Maybe (Path Abs)
-- >>> parseAbs "" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
-- Nothing
parseAbs :: MonadThrow m
=> ByteString -> m (Path Abs)
@@ -141,23 +144,23 @@ parseAbs filepath =
--
-- Throws: 'PathParseException'
--
-- >>> parseRel "abc" :: Maybe (Path Rel)
-- >>> parseRel "abc" :: Maybe (Path Rel)
-- Just "abc"
-- >>> parseRel "def/" :: Maybe (Path Rel)
-- >>> parseRel "def/" :: Maybe (Path Rel)
-- Just "def/"
-- >>> parseRel "abc/def" :: Maybe (Path Rel)
-- >>> parseRel "abc/def" :: Maybe (Path Rel)
-- Just "abc/def"
-- >>> parseRel "abc/def/." :: Maybe (Path Rel)
-- >>> parseRel "abc/def/." :: Maybe (Path Rel)
-- Just "abc/def/"
-- >>> parseRel "/abc" :: Maybe (Path Rel)
-- >>> parseRel "/abc" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "" :: Maybe (Path Rel)
-- >>> parseRel "" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "abc/../foo" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "." :: Maybe (Path Rel)
-- >>> parseRel "." :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel ".." :: Maybe (Path Rel)
-- >>> parseRel ".." :: Maybe (Path Rel)
-- Nothing
parseRel :: MonadThrow m
=> ByteString -> m (Path Rel)
@@ -176,25 +179,25 @@ parseRel filepath =
--
-- Throws: 'PathParseException'
--
-- >>> parseFn "abc" :: Maybe (Path Fn)
-- >>> parseFn "abc" :: Maybe (Path Fn)
-- Just "abc"
-- >>> parseFn "..." :: Maybe (Path Fn)
-- >>> parseFn "..." :: Maybe (Path Fn)
-- Just "..."
-- >>> parseFn "def/" :: Maybe (Path Fn)
-- >>> parseFn "def/" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/def" :: Maybe (Path Fn)
-- >>> parseFn "abc/def" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/def/." :: Maybe (Path Fn)
-- >>> parseFn "abc/def/." :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "/abc" :: Maybe (Path Fn)
-- >>> parseFn "/abc" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "" :: Maybe (Path Fn)
-- >>> parseFn "" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/../foo" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "." :: Maybe (Path Fn)
-- >>> parseFn "." :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn ".." :: Maybe (Path Fn)
-- >>> parseFn ".." :: Maybe (Path Fn)
-- Nothing
parseFn :: MonadThrow m
=> ByteString -> m (Path Fn)
@@ -237,13 +240,13 @@ fromRel = toFilePath
-- because this library is IO-agnostic and makes no assumptions about
-- file types.
--
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- "/file"
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
-- "/path/to/file"
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
-- "/file/lal"
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- "/file/"
(</>) :: RelC r => Path b -> Path r -> Path b
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
@@ -257,15 +260,15 @@ fromRel = toFilePath
--
-- The bases must match.
--
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
-- Nothing
stripDir :: MonadThrow m
=> Path b -> Path b -> m (Path Rel)
@@ -281,15 +284,15 @@ stripDir (MkPath p) (MkPath l) =
-- | Is p a parent of the given location? Implemented in terms of
-- 'stripDir'. The bases must match.
--
-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")
-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")
-- True
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
-- True
-- >>> (MkPath "/") `isParentOf` (MkPath "/")
-- >>> (MkPath "/") `isParentOf` (MkPath "/")
-- False
-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")
-- False
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
-- False
isParentOf :: Path b -> Path b -> Bool
isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))
@@ -333,7 +336,7 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
--
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
-- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn)
basename (MkPath l)

View File

@@ -56,6 +56,7 @@ module HPath.IO
-- * File creation
, createRegularFile
, createDir
, createSymlink
-- * File renaming/moving
, renameFile
, moveFile
@@ -80,7 +81,6 @@ import Control.Applicative
import Control.Exception
(
bracket
, bracketOnError
, throwIO
)
import Control.Monad
@@ -107,6 +107,8 @@ import Data.Word
import Foreign.C.Error
(
eEXIST
, eINVAL
, eNOSYS
, eNOTEMPTY
, eXDEV
)
@@ -136,6 +138,11 @@ import System.IO.Error
catchIOError
, ioeGetErrorType
)
import System.Linux.Sendfile
(
sendfileFd
, FileRange(..)
)
import System.Posix.ByteString
(
exclusive
@@ -172,6 +179,10 @@ import System.Posix.Files.ByteString
import qualified System.Posix.Files.ByteString as PF
import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
import System.Posix.FD
(
openFd
)
import qualified System.Posix.Directory.Traversals as SPDT
import qualified System.Posix.Directory.Foreign as SPDF
import qualified System.Posix.Process.ByteString as SPP
@@ -229,8 +240,8 @@ data FileType = Directory
-- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source directory is wrong type (symlink)
-- - `InvalidArgument` if source directory is wrong type (regular file)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `AlreadyExists` if destination already exists
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
copyDirRecursive :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination
@@ -305,6 +316,7 @@ copyDirRecursiveOverwrite fromp destdirp
RegularFile -> copyFileOverwrite f newdest
_ -> return ()
-- |Recreate a symlink.
--
-- Throws:
@@ -338,10 +350,10 @@ recreateSymlink symsource newsym
-- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source file is wrong type (symlink)
-- - `InvalidArgument` if source file is wrong type (directory)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `AlreadyExists` if destination already exists
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
--
-- Note: calls `sendfile`
-- Note: calls `sendfile` and possibly `read`/`write` as fallback
copyFile :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file
-> IO ()
@@ -358,8 +370,7 @@ copyFile from to = do
--
-- Safety/reliability concerns:
--
-- * not atomic
-- * falls back to delete-copy method with explicit checks
-- * not atomic, since it uses read/write
--
-- Throws:
--
@@ -370,7 +381,7 @@ copyFile from to = do
-- - `InvalidArgument` if source file is wrong type (directory)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
--
-- Note: calls `sendfile`
-- Note: calls `sendfile` and possibly `read`/`write` as fallback
copyFileOverwrite :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file
-> IO ()
@@ -398,24 +409,35 @@ _copyFile :: [SPDF.Flags]
-> IO ()
_copyFile sflags dflags from to
=
-- TODO: add sendfile support
void $ readWriteCopy (fromAbs from) (fromAbs to)
-- from sendfile(2) manpage:
-- Applications may wish to fall back to read(2)/write(2) in the case
-- where sendfile() fails with EINVAL or ENOSYS.
withAbsPath to $ \to' -> withAbsPath from $ \from' ->
catchErrno [eINVAL, eNOSYS]
(sendFileCopy from' to')
(void $ readWriteCopy from' to')
where
-- low-level copy operation utilizing read(2)/write(2)
-- in case `sendFileCopy` fails/is unsupported
readWriteCopy :: ByteString -> ByteString -> IO Int
readWriteCopy source dest =
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
copyWith copyAction source dest =
bracket (openFd source SPI.ReadOnly sflags Nothing)
SPI.closeFd
$ \sfd -> do
fileM <- System.Posix.Files.ByteString.fileMode
<$> getFdStatus sfd
bracketeer (SPDT.openFd dest SPI.WriteOnly
bracketeer (openFd dest SPI.WriteOnly
dflags $ Just fileM)
SPI.closeFd
(\fd -> SPI.closeFd fd >> deleteFile to)
$ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->
write' sfd dfd buf 0
$ \dfd -> copyAction sfd dfd
-- this is low-level stuff utilizing sendfile(2) for speed
sendFileCopy :: ByteString -> ByteString -> IO ()
sendFileCopy = copyWith
(\sfd dfd -> sendfileFd dfd sfd EntireFile $ return ())
-- low-level copy operation utilizing read(2)/write(2)
-- in case `sendFileCopy` fails/is unsupported
readWriteCopy :: ByteString -> ByteString -> IO Int
readWriteCopy = copyWith
(\sfd dfd -> allocaBytes (fromIntegral bufSize)
$ \buf -> write' sfd dfd buf 0)
where
bufSize :: CSize
bufSize = 8192
@@ -473,7 +495,7 @@ easyCopyOverwrite from to = do
---------------------
-- |Deletes the given file, does not follow symlinks. Raises `eISDIR`
-- |Deletes the given file. Raises `eISDIR`
-- if run on a directory. Does not follow symbolic links.
--
-- Throws:
@@ -606,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)
----------------------------
@@ -628,8 +664,8 @@ createDir dest = createDirectory (fromAbs dest) newDirPerms
-- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened
-- - `UnsupportedOperation` if source and destination are on different devices
-- - `FileDoesExist` if destination file already exists
-- - `DirDoesExist` if destination directory already exists
-- - `FileDoesExist` if destination file already exists (`HPathIOException`)
-- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
-- - `SameFile` if destination and source are the same file (`HPathIOException`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
@@ -655,8 +691,8 @@ renameFile fromf tof = do
-- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened
-- - `FileDoesExist` if destination file already exists
-- - `DirDoesExist` if destination directory already exists
-- - `FileDoesExist` if destination file already exists (`HPathIOException`)
-- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
-- - `SameFile` if destination and source are the same file (`HPathIOException`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
@@ -755,14 +791,12 @@ newDirPerms
getDirsFiles :: Path Abs -- ^ dir to read
-> IO [Path Abs]
getDirsFiles p =
withAbsPath p $ \fp ->
bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing)
SPI.closeFd
$ \fd ->
return
. catMaybes
. fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents' fd
withAbsPath p $ \fp -> do
fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
return
. catMaybes
. fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents' fd
where
parseMaybe :: ByteString -> Maybe (Path Fn)
parseMaybe = parseFn

View File

@@ -66,6 +66,10 @@ import Data.ByteString
(
ByteString
)
import Data.ByteString.UTF8
(
toString
)
import Data.Data
(
Data(..)
@@ -114,20 +118,20 @@ data HPathIOException = FileDoesNotExist ByteString
instance Show HPathIOException where
show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp
show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp
show (DirDoesNotExist fp) = "Directory does not exist: "
++ fpToString fp
show (SameFile fp1 fp2) = fpToString fp1
++ " and " ++ fpToString fp2
++ toString fp
show (SameFile fp1 fp2) = toString fp1
++ " and " ++ toString fp2
++ " are the same file!"
show (DestinationInSource fp1 fp2) = fpToString fp1
show (DestinationInSource fp1 fp2) = toString fp1
++ " is contained in "
++ fpToString fp2
show (FileDoesExist fp) = "File does exist: " ++ fpToString fp
show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp
++ toString fp2
show (FileDoesExist fp) = "File does exist: " ++ toString fp
show (DirDoesExist fp) = "Directory does exist: " ++ toString fp
show (InvalidOperation str) = "Invalid operation: " ++ str
show (Can'tOpenDirectory fp) = "Can't open directory: "
++ fpToString fp
++ toString fp
show (CopyFailed str) = "Copying failed: " ++ str
@@ -209,12 +213,13 @@ 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
-- of the destination.
throwDestinationInSource :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination, `dirname dest`
-> Path Abs -- ^ full destination, @dirname dest@
-- must exist
-> IO ()
throwDestinationInSource source dest = do
@@ -266,7 +271,7 @@ canOpenDirectory fp =
return True
-- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given
-- |Throws a `Can'tOpenDirectory` HPathIOException if the directory at the given
-- path cannot be opened.
throwCantOpenDirectory :: Path Abs -> IO ()
throwCantOpenDirectory fp =
@@ -332,8 +337,8 @@ bracketeer before after afterEx thing =
reactOnError :: IO a
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(HPathIOException, IO a)] -- ^ reaction on FmIOException
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException
-> IO a
reactOnError a ios fmios =
a `catches` [iohandler, fmiohandler]

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

@@ -1,9 +1,24 @@
-- |
-- Module : System.Posix.Directory.Traversals
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Traversal and read operations on directories.
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
module System.Posix.Directory.Traversals (
getDirectoryContents
@@ -17,7 +32,7 @@ module System.Posix.Directory.Traversals (
, readDirEnt
, packDirStream
, unpackDirStream
, openFd
, fdOpendir
, realpath
) where
@@ -36,6 +51,7 @@ import System.Posix.Directory.ByteString as PosixBS
import System.Posix.Files.ByteString
import System.IO.Unsafe
import "unix" System.Posix.IO.ByteString (closeFd)
import Unsafe.Coerce (unsafeCoerce)
import Foreign.C.Error
import Foreign.C.String
@@ -54,6 +70,8 @@ import Foreign.Storable
-- Upon entering a directory, 'allDirectoryContents' will get all entries
-- strictly. However the returned list is lazy in that directories will only
-- be accessed on demand.
--
-- Follows symbolic links for the input dir.
allDirectoryContents :: RawFilePath -> IO [RawFilePath]
allDirectoryContents topdir = do
namesAndTypes <- getDirectoryContents topdir
@@ -71,6 +89,8 @@ allDirectoryContents topdir = do
return (topdir : concat paths)
-- | Get all files from a directory and its subdirectories strictly.
--
-- Follows symbolic links for the input dir.
allDirectoryContents' :: RawFilePath -> IO [RawFilePath]
allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []
-- this uses traverseDirectory because it's more efficient than forcing the
@@ -80,6 +100,8 @@ allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:
-- files/subdirectories.
--
-- This function allows for memory-efficient traversals.
--
-- Follows symbolic links for the input dir.
traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s
traverseDirectory act s0 topdir = toploop
where
@@ -103,17 +125,17 @@ actOnDirContents :: RawFilePath
-> IO b
actOnDirContents pathRelToTop b f =
modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .
(`ioeSetLocation` "findBSTypRel")) $ do
(`ioeSetLocation` "findBSTypRel")) $
bracket
(openDirStream pathRelToTop)
(Posix.closeDirStream)
Posix.closeDirStream
(\dirp -> loop dirp b)
where
loop dirp b' = do
(typ,e) <- readDirEnt dirp
if (e == "")
then return b'
else do
else
if (e == "." || e == "..")
then loop dirp b'
else f typ (pathRelToTop </> e) b' >>= loop dirp
@@ -154,9 +176,6 @@ foreign import ccall "realpath"
foreign import ccall unsafe "fdopendir"
c_fdopendir :: Posix.Fd -> IO (Ptr ())
foreign import ccall unsafe "open"
c_open :: CString -> CInt -> Posix.CMode -> IO CInt
----------------------------------------------------------
-- less dodgy but still lower-level
@@ -189,81 +208,53 @@ readDirEnt (unpackDirStream -> dirp) =
else throwErrno "readDirEnt"
-- |Gets all directory contents (not recursively).
getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]
getDirectoryContents path =
modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
(`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do
(`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $
bracket
(PosixBS.openDirStream path)
PosixBS.closeDirStream
loop
where
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
_dirloop
-- |Binding to @fdopendir(3)@.
fdOpendir :: Posix.Fd -> IO DirStream
fdOpendir fd =
packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
-- |Like `getDirectoryContents` except for a file descriptor.
--
-- To avoid complicated error checks, the file descriptor is
-- __always__ closed, even if `fdOpendir` fails. Usually, this
-- only happens on successful `fdOpendir` and after the directory
-- stream is closed. Also see the manpage of @fdopendir(3)@ for
-- more details.
getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)]
getDirectoryContents' fd =
bracket
(fdOpendir fd)
PosixBS.closeDirStream
loop
where
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
getDirectoryContents' fd = do
dirstream <- fdOpendir fd `catchIOError` \e -> do
closeFd fd
ioError e
-- closeDirStream closes the filedescriptor
finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)
open_ :: CString
-> Posix.OpenMode
-> [Flags]
-> Maybe Posix.FileMode
-> IO Posix.Fd
open_ str how optional_flags maybe_mode = do
fd <- c_open str all_flags mode_w
return (Posix.Fd fd)
where
all_flags = unionFlags $ optional_flags ++ [open_mode] ++ creat
(creat, mode_w) = case maybe_mode of
Nothing -> ([],0)
Just x -> ([oCreat], x)
open_mode = case how of
Posix.ReadOnly -> oRdonly
Posix.WriteOnly -> oWronly
Posix.ReadWrite -> oRdwr
-- |Open and optionally create this file. See 'System.Posix.Files'
-- for information on how to use the 'FileMode' type.
openFd :: RawFilePath
-> Posix.OpenMode
-> [Flags]
-> Maybe Posix.FileMode
-> IO Posix.Fd
openFd name how optional_flags maybe_mode =
withFilePath name $ \str ->
throwErrnoPathIfMinus1Retry "openFd" name $
open_ str how optional_flags maybe_mode
_dirloop :: DirStream -> IO [(DirType, RawFilePath)]
{-# INLINE _dirloop #-}
_dirloop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- _dirloop dirp
return (t:es)
-- | return the canonicalized absolute pathname
--
-- like canonicalizePath, but uses realpath(3)
-- like canonicalizePath, but uses @realpath(3)@
realpath :: RawFilePath -> IO RawFilePath
realpath inp = do
realpath inp =
allocaBytes pathMax $ \tmp -> do
void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp
BS.packCString tmp

75
src/System/Posix/FD.hs Normal file
View File

@@ -0,0 +1,75 @@
-- |
-- Module : System.Posix.FD
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Provides an alternative for `System.Posix.IO.ByteString.openFd`
-- which gives us more control on what status flags to pass to the
-- low-level @open(2)@ call, in contrast to the unix package.
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
module System.Posix.FD (
openFd
) where
import Foreign.C.String
import Foreign.C.Types
import System.Posix.Directory.Foreign
import qualified System.Posix as Posix
import System.Posix.ByteString.FilePath
foreign import ccall unsafe "open"
c_open :: CString -> CInt -> Posix.CMode -> IO CInt
open_ :: CString
-> Posix.OpenMode
-> [Flags]
-> Maybe Posix.FileMode
-> IO Posix.Fd
open_ str how optional_flags maybe_mode = do
fd <- c_open str all_flags mode_w
return (Posix.Fd fd)
where
all_flags = unionFlags $ optional_flags ++ [open_mode] ++ creat
(creat, mode_w) = case maybe_mode of
Nothing -> ([],0)
Just x -> ([oCreat], x)
open_mode = case how of
Posix.ReadOnly -> oRdonly
Posix.WriteOnly -> oWronly
Posix.ReadWrite -> oRdwr
-- |Open and optionally create this file. See 'System.Posix.Files'
-- for information on how to use the 'FileMode' type.
--
-- Note that passing @Just x@ as the 4th argument triggers the
-- `oCreat` status flag, which must be set when you pass in `oExcl`
-- to the status flags. Also see the manpage for @open(2)@.
openFd :: RawFilePath
-> Posix.OpenMode
-> [Flags] -- ^ status flags of @open(2)@
-> Maybe Posix.FileMode -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.
-> IO Posix.Fd
openFd name how optional_flags maybe_mode =
withFilePath name $ \str ->
throwErrnoPathIfMinus1Retry "openFd" name $
open_ str how optional_flags maybe_mode

View File

@@ -11,6 +11,8 @@
--
-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
@@ -18,7 +20,7 @@
module System.Posix.FilePath (
-- * Separators
-- * Separator predicates
pathSeparator
, isPathSeparator
, searchPathSeparator
@@ -26,7 +28,11 @@ module System.Posix.FilePath (
, extSeparator
, isExtSeparator
-- * File extensions
-- * $PATH methods
, splitSearchPath
, getSearchPath
-- * Extension functions
, splitExtension
, takeExtension
, replaceExtension
@@ -37,8 +43,9 @@ module System.Posix.FilePath (
, splitExtensions
, dropExtensions
, takeExtensions
, stripExtension
-- * Filenames/Directory names
-- * Filename\/directory functions
, splitFileName
, takeFileName
, replaceFileName
@@ -47,92 +54,135 @@ 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
-- * Type conversion
, fpToString
, userStringToFP
, module System.Posix.ByteString.FilePath
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (fromString, toString)
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
-- >>> import Data.ByteString (ByteString)
-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary
-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack
--
-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral
------------------------
-- Separator predicates
-- | Path separator character
pathSeparator :: Word8
pathSeparator = _slash
-- | Check if a character is the path separator
--
-- prop> \n -> (_chr n == '/') == isPathSeparator n
isPathSeparator :: Word8 -> Bool
isPathSeparator = (== pathSeparator)
-- | Search path separator
searchPathSeparator :: Word8
searchPathSeparator = _colon
-- | Check if a character is the search path separator
--
-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n
isSearchPathSeparator :: Word8 -> Bool
isSearchPathSeparator = (== searchPathSeparator)
-- | File extension separator
extSeparator :: Word8
extSeparator = _period
-- | Check if a character is the file extension separator
--
-- prop> \n -> (_chr n == '.') == isExtSeparator n
isExtSeparator :: Word8 -> Bool
isExtSeparator = (== extSeparator)
------------------------
-- 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
--
@@ -152,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"
@@ -163,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"
@@ -180,6 +233,7 @@ replaceExtension path ext = dropExtension path <.> ext
dropExtension :: RawFilePath -> RawFilePath
dropExtension = fst . splitExtension
-- | Add an extension to a 'RawFilePath'
--
-- >>> addExtension "file" ".exe"
@@ -195,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"
@@ -210,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")
@@ -224,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"
@@ -231,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"
@@ -238,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
--
@@ -269,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"
@@ -284,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"
@@ -293,6 +394,7 @@ dropFileName = fst . splitFileName
takeBaseName :: RawFilePath -> ByteString
takeBaseName = dropExtension . takeFileName
-- | Change the base name
--
-- >>> replaceBaseName "path/file.tar.gz" "bob"
@@ -305,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"
@@ -324,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"
@@ -342,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
@@ -363,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"
@@ -378,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.
@@ -442,139 +605,47 @@ normalise filepath =
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/"
-- 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.
-- >>> 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"
--
-- >>> 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
------------------------
-- Filename/system stuff
-- | Check if a path is absolute
--
-- >>> isAbsolute "/path"
-- True
-- >>> isAbsolute "path"
-- False
-- >>> isAbsolute ""
-- False
isAbsolute :: RawFilePath -> Bool
isAbsolute x
| BS.length x > 0 = isPathSeparator (BS.head x)
| otherwise = False
-- | 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?
--
-- >>> isValid ""
-- False
-- >>> isValid "\0"
-- False
-- >>> isValid "/random_ path:*"
-- True
isValid :: RawFilePath -> Bool
isValid filepath
| BS.null filepath = False
| _nul `BS.elem` filepath = False
| otherwise = True
-- | Is the given filename a valid filename?
--
-- >>> isFileName "lal"
-- True
-- >>> isFileName "."
-- True
-- >>> isFileName ".."
-- True
-- >>> isFileName ""
-- False
-- >>> isFileName "\0"
-- False
-- >>> isFileName "/random_ path:*"
-- False
isFileName :: ByteString -> Bool
isFileName filepath =
not (BS.singleton pathSeparator `BS.isInfixOf` filepath) &&
not (BS.null filepath) &&
not (_nul `BS.elem` filepath)
-- | Helper function: check if the filepath has any parent directories in it.
--
-- >>> hasParentDir "/.."
-- True
-- >>> hasParentDir "foo/bar/.."
-- True
-- >>> hasParentDir "foo/../bar/."
-- True
-- >>> hasParentDir "foo/bar"
-- False
-- >>> hasParentDir "foo"
-- False
-- >>> hasParentDir ""
-- False
-- >>> hasParentDir ".."
-- False
hasParentDir :: ByteString -> Bool
hasParentDir filepath =
((pathSeparator `BS.cons` pathDoubleDot)
`BS.isSuffixOf` filepath
) ||
((BS.singleton pathSeparator
`BS.append` pathDoubleDot
`BS.append` BS.singleton pathSeparator
) `BS.isInfixOf` filepath
) ||
((pathDoubleDot `BS.append` BS.singleton pathSeparator
) `BS.isPrefixOf` filepath
)
-- 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
pathDoubleDot = BS.pack [_period, _period]
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.
@@ -585,6 +656,8 @@ hasParentDir filepath =
-- True
-- >>> equalFilePath "foo" "./foo"
-- True
-- >>> equalFilePath "" ""
-- True
-- >>> equalFilePath "foo" "/foo"
-- False
-- >>> equalFilePath "foo" "FOO"
@@ -599,37 +672,138 @@ equalFilePath p1 p2 = f p1 == f p2
f x = dropTrailingPathSeparator $ normalise x
-- | Check if a path is relative
--
-- prop> \path -> isRelative path /= isAbsolute path
isRelative :: RawFilePath -> Bool
isRelative = not . isAbsolute
-- | Check if a path is absolute
--
-- >>> isAbsolute "/path"
-- True
-- >>> isAbsolute "path"
-- False
-- >>> isAbsolute ""
-- False
isAbsolute :: RawFilePath -> Bool
isAbsolute x
| BS.length x > 0 = isPathSeparator (BS.head x)
| otherwise = False
-- | Is a FilePath valid, i.e. could you create a file like it?
--
-- >>> isValid ""
-- False
-- >>> isValid "\0"
-- False
-- >>> isValid "/random_ path:*"
-- True
isValid :: RawFilePath -> Bool
isValid filepath
| BS.null filepath = False
| _nul `BS.elem` filepath = False
| otherwise = True
-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- >>> makeValid ""
-- "_"
-- >>> makeValid "file\0name"
-- "file_name"
--
-- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p
-- prop> \p -> isValid (makeValid p)
makeValid :: RawFilePath -> RawFilePath
makeValid path
| BS.null path = BS.singleton _underscore
| otherwise = BS.map (\x -> if x == _nul then _underscore else x) path
-- | Is the given path a valid filename? This includes
-- "." and "..".
--
-- >>> isFileName "lal"
-- True
-- >>> isFileName "."
-- True
-- >>> isFileName ".."
-- True
-- >>> isFileName ""
-- False
-- >>> isFileName "\0"
-- False
-- >>> isFileName "/random_ path:*"
-- False
isFileName :: RawFilePath -> Bool
isFileName filepath =
not (BS.singleton pathSeparator `BS.isInfixOf` filepath) &&
not (BS.null filepath) &&
not (_nul `BS.elem` filepath)
-- | Check if the filepath has any parent directories in it.
--
-- >>> hasParentDir "/.."
-- True
-- >>> hasParentDir "foo/bar/.."
-- True
-- >>> hasParentDir "foo/../bar/."
-- True
-- >>> hasParentDir "foo/bar"
-- False
-- >>> hasParentDir "foo"
-- False
-- >>> hasParentDir ""
-- False
-- >>> hasParentDir ".."
-- False
hasParentDir :: RawFilePath -> Bool
hasParentDir filepath =
(pathSeparator `BS.cons` pathDoubleDot)
`BS.isSuffixOf` filepath
||
(BS.singleton pathSeparator
`BS.append` pathDoubleDot
`BS.append` BS.singleton pathSeparator)
`BS.isInfixOf` filepath
||
(pathDoubleDot `BS.append` BS.singleton pathSeparator)
`BS.isPrefixOf` filepath
where
pathDoubleDot = BS.pack [_period, _period]
-- | Whether the file is a hidden file.
--
-- >>> hiddenFile ".foo"
-- True
-- >>> hiddenFile "..foo.bar"
-- True
-- >>> hiddenFile "some/path/.bar"
-- True
-- >>> hiddenFile "..."
-- True
-- >>> hiddenFile "dod"
-- False
-- >>> hiddenFile "dod.bar"
-- False
-- >>> hiddenFile "."
-- False
-- >>> hiddenFile ".."
-- False
-- >>> hiddenFile ""
-- False
hiddenFile :: RawFilePath -> Bool
hiddenFile fp
| fp == BS.pack [_period, _period] = False
| fp == BS.pack [_period] = False
| fn == BS.pack [_period, _period] = False
| fn == BS.pack [_period] = False
| otherwise = BS.pack [extSeparator]
`BS.isPrefixOf` fp
`BS.isPrefixOf` fn
where
fn = takeFileName fp
------------------------
-- conversion
-- |Uses UTF-8 decoding to convert the bytestring into a String.
fpToString :: ByteString -> String
fpToString = toString
-- |Uses UTF-8 encoding to convert a user provided String into
-- a ByteString, which represents a filepath.
userStringToFP :: String -> ByteString
userStringToFP = fromString
------------------------
@@ -638,7 +812,7 @@ userStringToFP = fromString
-- Just split the input FileName without adding/normalizing or changing
-- anything.
splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw x = BS.breakEnd isPathSeparator x
splitFileNameRaw = BS.breakEnd isPathSeparator
-- | Combine two paths, assuming rhs is NOT absolute.
combineRaw :: RawFilePath -> RawFilePath -> RawFilePath

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