57 Commits

Author SHA1 Message Date
809ffc7745 Add unsafeToString methods 2018-07-23 10:21:17 +08:00
a0510eaec1 Add stack.yaml 2018-07-19 13:33:55 +08:00
cce2c68cab Update .gitignore 2018-07-19 13:33:55 +08:00
3c5f06f41d Remove redundant imports in tests 2018-07-19 13:33:55 +08:00
6bc5381108 Add hackage-deps badge 2018-06-02 22:38:50 +02:00
ef51863180 Document use of 'getcwd' 2018-04-12 14:28:37 +02:00
09062351f5 Release 0.9.2 2018-04-12 02:23:56 +02:00
ab4137572e Fix travis typo 2018-04-12 02:20:51 +02:00
c03a7ec18f Merge branch 'tighten-base-bound' of https://github.com/gwils/hpath 2018-04-12 02:19:17 +02:00
George Wilson
df298f187e Tighten base bound to prevent building before GHC 7.6 2018-04-12 10:15:08 +10:00
466c72924a Fix travis build for ghc-7.6.3
Cabal sandboxes were introduced in cabal-install 1.18.
2018-04-12 02:12:34 +02:00
9dfb803ba8 Update travis matrix 2018-04-12 02:01:17 +02:00
de46a0c568 Raise required bytestring version
We use Builders, which were introduced in 0.10.0.0.
2018-04-12 01:42:18 +02:00
d9ba67b6f0 Fix build with ghc-7.6 2018-04-12 01:41:32 +02:00
9342abeb7a Release 0.9.1 2018-04-11 23:03:35 +02:00
e8cbc632c9 Fix build with ghc-7.8 2018-04-11 22:36:40 +02:00
c556a3d3e4 Fix build with ghc-7.10 2018-04-11 22:22:03 +02:00
3aee719130 Make "unbuildable on windows" explicit 2018-04-11 12:31:11 +02:00
10662ee803 Bump to 0.9.0 2018-04-11 01:12:12 +02:00
672875f48f Small .cabal cleanup 2018-04-11 01:11:40 +02:00
3e6d93182a Abstract over Path more properly
We don't expect "Path Abs" everywhere anymore. The functions
have been made to be more generic. A user can still pass
absolute paths, so we don't lose any safety. However, some
function implementations may be more tricky.
2018-04-11 01:11:00 +02:00
1c95c9f8f9 Bump to 0.8.1 2018-04-06 17:22:57 +02:00
0ec2cf8ca5 Add writeFile and appendFile 2018-04-06 17:22:38 +02:00
9ac10a6a7d Add file reading functions 2018-04-06 16:42:40 +02:00
1a2c77c6a6 dirname: remove incorrect documentation on properties
Fixes #11
2017-01-14 20:16:25 +01:00
3baecb7b51 Improve CopyDirRecursiveCollectFailures tests 2016-06-14 19:32:33 +02:00
5d5b0ae3c1 Add missing language pragma 2016-06-14 19:32:14 +02:00
f47c8edb42 Fix build for GHC < 7.10 2016-06-14 19:21:03 +02:00
ef66a24f87 Improve error handling
* remove some obsolete functions and error types from HPath.IO.Errors
  that are completely unused
* reworked the RecursiveFailure type to contain more information,
  so we can use it to programmatically make useful choices
  without examining the weakly types IO error attributes (like
  'ioGetFileName')
2016-06-14 19:13:25 +02:00
f6a5cb8668 Add test to basename 2016-06-13 13:51:53 +02:00
4dec385332 Improve createDirRecursive 2016-06-13 01:38:44 +02:00
5b08e14b55 Add createDirRecursive, fixes #6 2016-06-13 01:28:55 +02:00
ac381cbf60 Improve documentation 2016-06-05 22:19:30 +02:00
ce7fdcdcd6 Move documentation note about RecursiveFailure where it belongs 2016-06-05 22:04:16 +02:00
a31c9d1e88 Improve documentation and tests for file creation 2016-06-05 21:59:31 +02:00
a5942ff026 Use IfElse package for whenM/unlessM 2016-06-05 21:52:52 +02:00
4d71ad08ce Release 0.8.0 2016-06-05 17:56:31 +02:00
92017ab630 Make createRegularFile and createDir accept FileMode parameter 2016-06-05 17:46:25 +02:00
16af98b32d Be more specific about Overwrite mode 2016-06-05 16:38:54 +02:00
6da01e382f Improve documentation 2016-06-05 16:31:08 +02:00
ed06543981 Proper GHC conditionals to fix compiler warnings 2016-06-05 16:16:41 +02:00
d3eb2fc254 Fix build with GHC-7.8 2016-06-05 16:12:51 +02:00
a1eb06324f Rm unused imports 2016-06-05 16:09:34 +02:00
d12ce30f57 Fix docs and rename RecursiveMode to RecursiveErrorMode 2016-06-05 16:07:46 +02:00
7a6f0e8728 Fix spelling 2016-06-05 16:00:15 +02:00
7ed5829d47 Fix documentation 2016-06-05 15:57:41 +02:00
d708f80a1f TESTS: don't assume ordering of exceptions 2016-06-05 15:37:26 +02:00
f07619b7c6 TESTS: fix before/after 2016-06-05 15:25:57 +02:00
c5bcb90b65 TESTS: don't use lazy IO -.- 2016-06-05 14:55:21 +02:00
4f047dbc77 TESTS: import unsafePerformIO from System.IO.Unsafe 2016-06-05 14:46:45 +02:00
bc348c7dd5 TESTS: less side effects plz 2016-06-05 14:33:53 +02:00
5d1c5cc2ce Fix linter warning 2016-06-05 03:26:05 +02:00
8f6ca81d22 Add tests to RecreateSymlinkOverwriteSpec 2016-06-05 03:22:35 +02:00
a27d4ed55d Improve documentation 2016-06-05 03:22:11 +02:00
64ae6db83a New API: use CopyMode for overwriting and introduce RecursiveMode
This allows to specify the behavior on recursive operations,
such that one can collect failures instead of dying on the first
failure.
2016-06-05 03:13:33 +02:00
2a0a88a96d Release 0.7.5 2016-06-04 00:39:03 +02:00
69dbf6714d Relicense to BSD3 2016-06-04 00:39:03 +02:00
40 changed files with 2172 additions and 712 deletions

2
.gitignore vendored
View File

@@ -10,3 +10,5 @@ tags
.stack-work/ .stack-work/
.cabal-sandbox/ .cabal-sandbox/
cabal.sandbox.config cabal.sandbox.config
dist-newstyle/
.ghc.environment.*

View File

@@ -7,12 +7,18 @@ dist: trusty
matrix: matrix:
include: include:
- env: CABALVER=1.18 GHCVER=7.6.3
addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.8.4 - env: CABALVER=1.22 GHCVER=7.8.4
addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=7.10.2 - env: CABALVER=1.24 GHCVER=7.10.2
addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1 - env: CABALVER=1.24 GHCVER=8.0.1
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
- env: CABALVER=2.0 GHCVER=8.2.2
addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
- env: CABALVER=2.2 GHCVER=8.4.1
addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.1], sources: [hvr-ghc]}}
- env: CABALVER=head GHCVER=head - env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}

View File

@@ -1,3 +1,20 @@
0.9.2
* fix build with ghc-7.6
* raise required bytestring version
* Tighten base bound to prevent building before GHC 7.6 (by George Wilson)
0.9.1
* fix build with ghc-7.8 and 7.10
0.9.0
* don't force "Path Abs" anymore in IO module, abstract more over Path types
* add 'toAbs'
0.8.1
* add 'readFile', 'readFileEOF', 'writeFile' and 'appendFile'
0.8.0
* 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument
* introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior)
* 'createRegularFile' and 'createDir' now take FileMode as a parameter (also see 'newFilePerms' and 'newDirPerms')
* various documentation fixes
* improved reliability of tests
0.7.5: 0.7.5:
* relicense to BSD3 * relicense to BSD3
0.7.3: 0.7.3:

View File

@@ -1,6 +1,6 @@
# HPath # HPath
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath.svg)](http://packdeps.haskellers.com/feed?needle=hpath)
Support for well-typed paths in Haskell. Also provides ByteString based filepath Support for well-typed paths in Haskell. Also provides ByteString based filepath
manipulation. manipulation.

View File

@@ -8,6 +8,7 @@ main =
doctest doctest
["-isrc" ["-isrc"
, "-XOverloadedStrings" , "-XOverloadedStrings"
, "-XScopedTypeVariables"
, "src/HPath.hs" , "src/HPath.hs"
] ]

View File

@@ -1,5 +1,5 @@
name: hpath name: hpath
version: 0.7.5 version: 0.9.2
synopsis: Support for well-typed paths synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood. description: Support for well-typed paths, utilizing ByteString under the hood.
license: BSD3 license: BSD3
@@ -9,7 +9,7 @@ maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald 2016 copyright: Julian Ospald 2016
category: Filesystem category: Filesystem
build-type: Simple build-type: Simple
cabal-version: >=1.14 cabal-version: 1.14
extra-source-files: README.md extra-source-files: README.md
CHANGELOG CHANGELOG
cbits/dirutils.h cbits/dirutils.h
@@ -17,21 +17,27 @@ extra-source-files: README.md
doctests-posix.hs doctests-posix.hs
library library
if os(windows)
build-depends: unbuildable<0
buildable: False
hs-source-dirs: src/ hs-source-dirs: src/
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall if impl(ghc >= 8.0)
ghc-options: -Wall -Wno-redundant-constraints
else
ghc-options: -Wall
c-sources: cbits/dirutils.c c-sources: cbits/dirutils.c
exposed-modules: HPath, exposed-modules: HPath,
HPath.IO, HPath.IO,
HPath.IO.Errors, HPath.IO.Errors,
HPath.IO.Utils,
System.Posix.Directory.Foreign, System.Posix.Directory.Foreign,
System.Posix.Directory.Traversals, System.Posix.Directory.Traversals,
System.Posix.FD, System.Posix.FD,
System.Posix.FilePath System.Posix.FilePath
other-modules: HPath.Internal other-modules: HPath.Internal
build-depends: base >= 4.2 && <5 build-depends: base >= 4.6 && <5
, bytestring >= 0.9.2.0 , IfElse
, bytestring >= 0.10.0.0
, deepseq , deepseq
, exceptions , exceptions
, hspec , hspec
@@ -43,6 +49,9 @@ library
test-suite doctests-hpath test-suite doctests-hpath
if os(windows)
build-depends: unbuildable<0
buildable: False
default-language: Haskell2010 default-language: Haskell2010
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
ghc-options: -threaded ghc-options: -threaded
@@ -54,12 +63,15 @@ test-suite doctests-hpath
, hpath , hpath
test-suite doctests-posix test-suite doctests-posix
if os(windows)
build-depends: unbuildable<0
buildable: False
default-language: Haskell2010 default-language: Haskell2010
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
ghc-options: -threaded ghc-options: -threaded
main-is: doctests-posix.hs main-is: doctests-posix.hs
build-depends: base, build-depends: base,
bytestring, bytestring >= 0.10.0.0,
unix, unix,
hpath, hpath,
doctest >= 0.8, doctest >= 0.8,
@@ -67,16 +79,22 @@ test-suite doctests-posix
QuickCheck QuickCheck
test-suite spec test-suite spec
if os(windows)
build-depends: unbuildable<0
buildable: False
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Default-Language: Haskell2010 Default-Language: Haskell2010
Hs-Source-Dirs: test Hs-Source-Dirs: test
Main-Is: Main.hs Main-Is: Main.hs
other-modules: other-modules:
HPath.IO.AppendFileSpec
HPath.IO.CanonicalizePathSpec HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveCollectFailuresSpec
HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec HPath.IO.CopyFileOverwriteSpec
HPath.IO.CopyFileSpec HPath.IO.CopyFileSpec
HPath.IO.CreateDirRecursiveSpec
HPath.IO.CreateDirSpec HPath.IO.CreateDirSpec
HPath.IO.CreateRegularFileSpec HPath.IO.CreateRegularFileSpec
HPath.IO.CreateSymlinkSpec HPath.IO.CreateSymlinkSpec
@@ -87,14 +105,20 @@ test-suite spec
HPath.IO.GetFileTypeSpec HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec HPath.IO.MoveFileSpec
HPath.IO.ReadFileEOFSpec
HPath.IO.ReadFileSpec
HPath.IO.RecreateSymlinkOverwriteSpec
HPath.IO.RecreateSymlinkSpec HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec HPath.IO.RenameFileSpec
HPath.IO.ToAbsSpec
HPath.IO.WriteFileSpec
Spec Spec
Utils Utils
GHC-Options: -Wall GHC-Options: -Wall
Build-Depends: base Build-Depends: base
, HUnit , HUnit
, bytestring , IfElse
, bytestring >= 0.10.0.0
, hpath , hpath
, hspec >= 1.3 , hspec >= 1.3
, process , process

View File

@@ -10,10 +10,14 @@
-- Support for well-typed paths. -- Support for well-typed paths.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE ScopedTypeVariables #-}
module HPath module HPath
( (
@@ -25,8 +29,10 @@ module HPath
,PathParseException ,PathParseException
,PathException ,PathException
,RelC ,RelC
#if __GLASGOW_HASKELL__ >= 708
-- * PatternSynonyms/ViewPatterns -- * PatternSynonyms/ViewPatterns
,pattern Path ,pattern Path
#endif
-- * Path Parsing -- * Path Parsing
,parseAbs ,parseAbs
,parseFn ,parseFn
@@ -35,6 +41,8 @@ module HPath
,fromAbs ,fromAbs
,fromRel ,fromRel
,toFilePath ,toFilePath
,unsafeToString
,unsafeToString'
-- * Path Operations -- * Path Operations
,(</>) ,(</>)
,basename ,basename
@@ -49,8 +57,10 @@ module HPath
) )
where where
import Control.Exception (Exception) import Control.Exception (IOException, Exception, catch)
import Control.Monad ((<$!>))
import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString.Unsafe(unsafeUseAsCStringLen)
#if MIN_VERSION_bytestring(0,10,8) #if MIN_VERSION_bytestring(0,10,8)
import Data.ByteString(ByteString, stripPrefix) import Data.ByteString(ByteString, stripPrefix)
#else #else
@@ -61,10 +71,17 @@ import qualified Data.ByteString as BS
import Data.Data import Data.Data
import Data.Maybe import Data.Maybe
import Data.Word8 import Data.Word8
import GHC.Foreign(peekCStringLen)
import GHC.IO.Encoding(getLocaleEncoding, TextEncoding)
import HPath.Internal import HPath.Internal
import System.IO.Unsafe(unsafePerformIO)
import System.Posix.FilePath hiding ((</>)) import System.Posix.FilePath hiding ((</>))
-- $setup
-- >>> import GHC.IO.Encoding(utf8)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Types -- Types
@@ -101,7 +118,9 @@ instance RelC Fn
#if __GLASGOW_HASKELL__ >= 710 #if __GLASGOW_HASKELL__ >= 710
pattern Path :: ByteString -> Path a pattern Path :: ByteString -> Path a
#endif #endif
#if __GLASGOW_HASKELL__ >= 708
pattern Path x <- (MkPath x) pattern Path x <- (MkPath x)
#endif
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Path Parsers -- Path Parsers
@@ -226,6 +245,41 @@ fromAbs = toFilePath
fromRel :: RelC r => Path r -> ByteString fromRel :: RelC r => Path r -> ByteString
fromRel = toFilePath fromRel = toFilePath
-- | This converts the underlying bytestring of the path to an unsafe
-- FilePath by assuming the encoding of the current locale setting. This
-- may be utterly wrong, but isn't particularly worse than what the
-- base library does. Blows up on decoding errors.
--
-- >>> unsafeToString (MkPath "/lal/lad")
-- "/lal/lad"
-- >>> unsafeToString (MkPath "/")
-- "/"
-- >>> unsafeToString (MkPath "lad")
-- "lad"
-- >>> catch (Just <$> unsafeToString (MkPath "<22>")) (\(_ :: IOException) -> pure Nothing)
-- Nothing
unsafeToString :: Path b -> IO FilePath
unsafeToString (MkPath p) = do
enc <- getLocaleEncoding
unsafeUseAsCStringLen p (peekCStringLen enc)
-- | Same as @unsafeToString@, except requires the encoding
-- to be passed explicitly. This uses 'unsafePerformIO' and
-- returns 'Nothing' on decoding errors.
--
-- >>> unsafeToString' (MkPath "/lal/lad") utf8
-- Just "/lal/lad"
-- >>> unsafeToString' (MkPath "/") utf8
-- Just "/"
-- >>> unsafeToString' (MkPath "lad") utf8
-- Just "lad"
-- >>> unsafeToString' (MkPath "<22>") utf8
-- Nothing
unsafeToString' :: Path b -> TextEncoding -> Maybe FilePath
unsafeToString' (MkPath !p) enc =
unsafePerformIO $!
catch (Just <$!> unsafeUseAsCStringLen p (peekCStringLen enc))
(\(_ :: IOException) -> pure Nothing)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@@ -314,10 +368,6 @@ getAllParents (MkPath p)
-- | Extract the directory name of a path. -- | Extract the directory name of a path.
-- --
-- The following properties hold:
--
-- @dirname (p \<\/> a) == dirname p@
--
-- >>> dirname (MkPath "/abc/def/dod") -- >>> dirname (MkPath "/abc/def/dod")
-- "/abc/def" -- "/abc/def"
-- >>> dirname (MkPath "/") -- >>> dirname (MkPath "/")
@@ -336,6 +386,8 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
-- --
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn) -- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
-- Just "dod" -- Just "dod"
-- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Fn)
-- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn) -- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- Nothing -- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn) basename :: MonadThrow m => Path b -> m (Path Fn)

File diff suppressed because it is too large Load Diff

View File

@@ -3,5 +3,6 @@ module HPath.IO where
import HPath import HPath
canonicalizePath :: Path Abs -> IO (Path Abs) canonicalizePath :: Path b -> IO (Path Abs)
toAbs :: Path b -> IO (Path Abs)

View File

@@ -16,23 +16,20 @@ module HPath.IO.Errors
( (
-- * Types -- * Types
HPathIOException(..) HPathIOException(..)
, RecursiveFailureHint(..)
-- * Exception identifiers -- * Exception identifiers
, isFileDoesNotExist
, isDirDoesNotExist
, isSameFile , isSameFile
, isDestinationInSource , isDestinationInSource
, isFileDoesExist , isRecursiveFailure
, isDirDoesExist , isReadContentsFailed
, isInvalidOperation , isCreateDirFailed
, isCan'tOpenDirectory , isCopyFileFailed
, isCopyFailed , isRecreateSymlinkFailed
-- * Path based functions -- * Path based functions
, throwFileDoesExist , throwFileDoesExist
, throwDirDoesExist , throwDirDoesExist
, throwFileDoesNotExist
, throwDirDoesNotExist
, throwSameFile , throwSameFile
, sameFile , sameFile
, throwDestinationInSource , throwDestinationInSource
@@ -40,7 +37,6 @@ module HPath.IO.Errors
, doesDirectoryExist , doesDirectoryExist
, isWritable , isWritable
, canOpenDirectory , canOpenDirectory
, throwCantOpenDirectory
-- * Error handling functions -- * Error handling functions
, catchErrno , catchErrno
@@ -62,6 +58,10 @@ import Control.Monad
forM forM
, when , when
) )
import Control.Monad.IfElse
(
whenM
)
import Data.ByteString import Data.ByteString
( (
ByteString ByteString
@@ -70,11 +70,10 @@ import Data.ByteString.UTF8
( (
toString toString
) )
import Data.Data
(
Data(..)
)
import Data.Typeable import Data.Typeable
(
Typeable
)
import Foreign.C.Error import Foreign.C.Error
( (
getErrno getErrno
@@ -85,15 +84,21 @@ import GHC.IO.Exception
IOErrorType IOErrorType
) )
import HPath import HPath
import HPath.Internal
(
Path(..)
)
import {-# SOURCE #-} HPath.IO import {-# SOURCE #-} HPath.IO
( (
canonicalizePath canonicalizePath
, toAbs
) )
import HPath.IO.Utils
import System.IO.Error import System.IO.Error
( (
catchIOError alreadyExistsErrorType
, catchIOError
, ioeGetErrorType , ioeGetErrorType
, mkIOError
) )
import qualified System.Posix.Directory.ByteString as PFD import qualified System.Posix.Directory.ByteString as PFD
@@ -105,40 +110,36 @@ import System.Posix.Files.ByteString
import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.Files.ByteString as PF
data HPathIOException = FileDoesNotExist ByteString -- |Additional generic IO exceptions that the posix functions
| DirDoesNotExist ByteString -- do not provide.
| SameFile ByteString ByteString data HPathIOException = SameFile ByteString ByteString
| DestinationInSource ByteString ByteString | DestinationInSource ByteString ByteString
| FileDoesExist ByteString | RecursiveFailure [(RecursiveFailureHint, IOException)]
| DirDoesExist ByteString deriving (Eq, Show, Typeable)
| InvalidOperation String
| Can'tOpenDirectory ByteString
| CopyFailed String
deriving (Typeable, Eq, Data)
instance Show HPathIOException where -- |A type for giving failure hints on recursive failure, which allows
show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp -- to programmatically make choices without examining
show (DirDoesNotExist fp) = "Directory does not exist: " -- the weakly typed I/O error attributes (like `ioeGetFileName`).
++ toString fp --
show (SameFile fp1 fp2) = toString fp1 -- The first argument to the data constructor is always the
++ " and " ++ toString fp2 -- source and the second the destination.
++ " are the same file!" data RecursiveFailureHint = ReadContentsFailed ByteString ByteString
show (DestinationInSource fp1 fp2) = toString fp1 | CreateDirFailed ByteString ByteString
++ " is contained in " | CopyFileFailed ByteString ByteString
++ toString fp2 | RecreateSymlinkFailed ByteString ByteString
show (FileDoesExist fp) = "File does exist: " ++ toString fp deriving (Eq, Show)
show (DirDoesExist fp) = "Directory does exist: " ++ toString fp
show (InvalidOperation str) = "Invalid operation: " ++ str
show (Can'tOpenDirectory fp) = "Can't open directory: "
++ toString fp
show (CopyFailed str) = "Copying failed: " ++ str
instance Exception HPathIOException instance Exception HPathIOException
toConstr :: HPathIOException -> String
toConstr SameFile {} = "SameFile"
toConstr DestinationInSource {} = "DestinationInSource"
toConstr RecursiveFailure {} = "RecursiveFailure"
@@ -146,16 +147,23 @@ instance Exception HPathIOException
--[ Exception identifiers ]-- --[ Exception identifiers ]--
----------------------------- -----------------------------
isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed :: HPathIOException -> Bool
isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{} isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool
isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{}
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{} isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{}
isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{} isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{}
isFileDoesExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesExist{} isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{}
isDirDoesExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesExist{}
isInvalidOperation ex = toConstr (ex :: HPathIOException) == toConstr InvalidOperation{}
isCan'tOpenDirectory ex = toConstr (ex :: HPathIOException) == toConstr Can'tOpenDirectory{} isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool
isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{} isReadContentsFailed ReadContentsFailed{} = True
isReadContentsFailed _ = False
isCreateDirFailed CreateDirFailed{} = True
isCreateDirFailed _ = False
isCopyFileFailed CopyFileFailed{} = True
isCopyFileFailed _ = False
isRecreateSymlinkFailed RecreateSymlinkFailed{} = True
isRecreateSymlinkFailed _ = False
@@ -165,52 +173,51 @@ isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{}
---------------------------- ----------------------------
throwFileDoesExist :: Path Abs -> IO () -- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist fp = throwFileDoesExist :: Path b -> IO ()
whenM (doesFileExist fp) (throwIO . FileDoesExist throwFileDoesExist fp@(MkPath bs) =
. fromAbs $ fp) whenM (doesFileExist fp)
(ioError . mkIOError
alreadyExistsErrorType
"File already exists"
Nothing
$ (Just (toString $ bs))
)
throwDirDoesExist :: Path Abs -> IO () -- |Throws `AlreadyExists` `IOError` if directory exists.
throwDirDoesExist fp = throwDirDoesExist :: Path b -> IO ()
whenM (doesDirectoryExist fp) (throwIO . DirDoesExist throwDirDoesExist fp@(MkPath bs) =
. fromAbs $ fp) whenM (doesDirectoryExist fp)
(ioError . mkIOError
alreadyExistsErrorType
throwFileDoesNotExist :: Path Abs -> IO () "Directory already exists"
throwFileDoesNotExist fp = Nothing
unlessM (doesFileExist fp) (throwIO . FileDoesNotExist $ (Just (toString $ bs))
. fromAbs $ fp) )
throwDirDoesNotExist :: Path Abs -> IO ()
throwDirDoesNotExist fp =
unlessM (doesDirectoryExist fp) (throwIO . DirDoesNotExist
. fromAbs $ fp)
-- |Uses `isSameFile` and throws `SameFile` if it returns True. -- |Uses `isSameFile` and throws `SameFile` if it returns True.
throwSameFile :: Path Abs throwSameFile :: Path b1
-> Path Abs -> Path b2
-> IO () -> IO ()
throwSameFile fp1 fp2 = throwSameFile fp1@(MkPath bs1) fp2@(MkPath bs2) =
whenM (sameFile fp1 fp2) whenM (sameFile fp1 fp2)
(throwIO $ SameFile (fromAbs fp1) (fromAbs fp2)) (throwIO $ SameFile bs1 bs2)
-- |Check if the files are the same by examining device and file id. -- |Check if the files are the same by examining device and file id.
-- This follows symbolic links. -- This follows symbolic links.
sameFile :: Path Abs -> Path Abs -> IO Bool sameFile :: Path b1 -> Path b2 -> IO Bool
sameFile fp1 fp2 = sameFile (MkPath fp1) (MkPath fp2) =
withAbsPath fp1 $ \fp1' -> withAbsPath fp2 $ \fp2' -> handleIOError (\_ -> return False) $ do
handleIOError (\_ -> return False) $ do fs1 <- getFileStatus fp1
fs1 <- getFileStatus fp1' fs2 <- getFileStatus fp2
fs2 <- getFileStatus fp2'
if ((PF.deviceID fs1, PF.fileID fs1) == if ((PF.deviceID fs1, PF.fileID fs1) ==
(PF.deviceID fs2, PF.fileID fs2)) (PF.deviceID fs2, PF.fileID fs2))
then return True then return True
else return False else return False
-- TODO: make this more robust when destination does not exist -- TODO: make this more robust when destination does not exist
@@ -218,66 +225,59 @@ sameFile fp1 fp2 =
-- within the source directory by comparing the device+file ID of the -- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories -- source directory with all device+file IDs of the parent directories
-- of the destination. -- of the destination.
throwDestinationInSource :: Path Abs -- ^ source dir throwDestinationInSource :: Path b1 -- ^ source dir
-> Path Abs -- ^ full destination, @dirname dest@ -> Path b2 -- ^ full destination, @dirname dest@
-- must exist -- must exist
-> IO () -> IO ()
throwDestinationInSource source dest = do throwDestinationInSource (MkPath sbs) dest@(MkPath dbs) = do
destAbs <- toAbs dest
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest) dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest)
<$> (canonicalizePath $ dirname dest) <$> (canonicalizePath $ dirname destAbs)
dids <- forM (getAllParents dest') $ \p -> do dids <- forM (getAllParents dest') $ \p -> do
fs <- PF.getSymbolicLinkStatus (fromAbs p) fs <- PF.getSymbolicLinkStatus (fromAbs p)
return (PF.deviceID fs, PF.fileID fs) return (PF.deviceID fs, PF.fileID fs)
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
$ PF.getFileStatus (fromAbs source) $ PF.getFileStatus sbs
when (elem sid dids) when (elem sid dids)
(throwIO $ DestinationInSource (fromAbs dest) (throwIO $ DestinationInSource dbs sbs)
(fromAbs source))
-- |Checks if the given file exists and is not a directory. -- |Checks if the given file exists and is not a directory.
-- Does not follow symlinks. -- Does not follow symlinks.
doesFileExist :: Path Abs -> IO Bool doesFileExist :: Path b -> IO Bool
doesFileExist fp = doesFileExist (MkPath bs) =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
fs <- PF.getSymbolicLinkStatus (fromAbs fp) fs <- PF.getSymbolicLinkStatus bs
return $ not . PF.isDirectory $ fs return $ not . PF.isDirectory $ fs
-- |Checks if the given file exists and is a directory. -- |Checks if the given file exists and is a directory.
-- Does not follow symlinks. -- Does not follow symlinks.
doesDirectoryExist :: Path Abs -> IO Bool doesDirectoryExist :: Path b -> IO Bool
doesDirectoryExist fp = doesDirectoryExist (MkPath bs) =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
fs <- PF.getSymbolicLinkStatus (fromAbs fp) fs <- PF.getSymbolicLinkStatus bs
return $ PF.isDirectory fs return $ PF.isDirectory fs
-- |Checks whether a file or folder is writable. -- |Checks whether a file or folder is writable.
isWritable :: Path Abs -> IO Bool isWritable :: Path b -> IO Bool
isWritable fp = isWritable (MkPath bs) =
handleIOError (\_ -> return False) $ handleIOError (\_ -> return False) $
fileAccess (fromAbs fp) False True False fileAccess bs False True False
-- |Checks whether the directory at the given path exists and can be -- |Checks whether the directory at the given path exists and can be
-- opened. This invokes `openDirStream` which follows symlinks. -- opened. This invokes `openDirStream` which follows symlinks.
canOpenDirectory :: Path Abs -> IO Bool canOpenDirectory :: Path b -> IO Bool
canOpenDirectory fp = canOpenDirectory (MkPath bs) =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
bracket (PFD.openDirStream . fromAbs $ fp) bracket (PFD.openDirStream bs)
PFD.closeDirStream PFD.closeDirStream
(\_ -> return ()) (\_ -> return ())
return True return True
-- |Throws a `Can'tOpenDirectory` HPathIOException if the directory at the given
-- path cannot be opened.
throwCantOpenDirectory :: Path Abs -> IO ()
throwCantOpenDirectory fp =
unlessM (canOpenDirectory fp)
(throwIO . Can'tOpenDirectory . fromAbs $ fp)
-------------------------------- --------------------------------
@@ -357,3 +357,4 @@ reactOnError a ios fmios =
else y) else y)
(throwIO ex) (throwIO ex)
fmios fmios

View File

@@ -1,32 +0,0 @@
-- |
-- Module : HPath.IO.Utils
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Random and general IO/monad utilities.
module HPath.IO.Utils where
import Control.Monad
(
when
, unless
)
-- |If the value of the first argument is True, then execute the action
-- provided in the second argument, otherwise do nothing.
whenM :: Monad m => m Bool -> m () -> m ()
whenM mb a = mb >>= (`when` a)
-- |If the value of the first argument is False, then execute the action
-- provided in the second argument, otherwise do nothing.
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb a = mb >>= (`unless` a)

View File

@@ -10,6 +10,7 @@
-- Traversal and read operations on directories. -- Traversal and read operations on directories.
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
@@ -37,7 +38,10 @@ module System.Posix.Directory.Traversals (
, realpath , realpath
) where ) where
import Control.Applicative
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad import Control.Monad
import System.Posix.FilePath ((</>)) import System.Posix.FilePath ((</>))
import System.Posix.Directory.Foreign import System.Posix.Directory.Foreign

7
stack.yaml Normal file
View File

@@ -0,0 +1,7 @@
resolver: lts-12.1
packages:
- '.'
extra-deps:
- IfElse-0.85

View File

@@ -0,0 +1,108 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.AppendFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "AppendFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.appendFile" $ do
-- successes --
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllll"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file without content, everything clear" $ do
appendFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "appendFile, everything clear" $ do
appendFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllllgagagaga"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga"
-- posix failures --
it "appendFile to dir, inappropriate type" $ do
appendFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "appendFile, no permissions to file" $ do
appendFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, no permissions to file" $ do
appendFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, file does not exist" $ do
appendFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -13,12 +13,15 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CanonicalizePathSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "file" createRegularFile' "file"
@@ -37,7 +40,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.canonicalizePath" $ do describe "HPath.IO.canonicalizePath" $ do
-- successes -- -- successes --

View File

@@ -0,0 +1,247 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyDirRecursiveCollectFailuresSpec where
import Test.Hspec
import Data.List (sort)
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveCollectFailuresSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "alreadyExists"
createRegularFile' "wrongInput"
createSymlink' "wrongInputSymL" "inputDir/"
createDir' "alreadyExistsD"
createDir' "noPerms"
createDir' "noWritePerm"
createDir' "inputDir"
createDir' "inputDir/bar"
createDir' "inputDir/foo"
createRegularFile' "inputDir/foo/inputFile1"
createRegularFile' "inputDir/inputFile2"
createRegularFile' "inputDir/bar/inputFile3"
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"
writeFile' "inputDir/inputFile2" "Blahfaselgagaga"
writeFile' "inputDir/bar/inputFile3"
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"
createDir' "inputDir1"
createDir' "inputDir1/foo2"
createDir' "inputDir1/foo2/foo3"
createDir' "inputDir1/foo2/foo4"
createRegularFile' "inputDir1/foo2/inputFile1"
createRegularFile' "inputDir1/foo2/inputFile2"
createRegularFile' "inputDir1/foo2/inputFile3"
createRegularFile' "inputDir1/foo2/foo4/inputFile4"
createRegularFile' "inputDir1/foo2/foo4/inputFile6"
createRegularFile' "inputDir1/foo2/foo3/inputFile5"
noPerms "inputDir1/foo2/foo3"
createDir' "outputDir1"
createDir' "outputDir1/foo2"
createDir' "outputDir1/foo2/foo4"
createDir' "outputDir1/foo2/foo4/inputFile4"
createRegularFile' "outputDir1/foo2/foo4/inputFile6"
noPerms "outputDir1/foo2/foo4/inputFile4"
noPerms "outputDir1/foo2/foo4"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
normalDirPerms "inputDir1/foo2/foo3"
deleteFile' "inputDir1/foo2/foo4/inputFile4"
deleteFile' "inputDir1/foo2/foo4/inputFile6"
deleteFile' "inputDir1/foo2/inputFile1"
deleteFile' "inputDir1/foo2/inputFile2"
deleteFile' "inputDir1/foo2/inputFile3"
deleteFile' "inputDir1/foo2/foo3/inputFile5"
deleteDir' "inputDir1/foo2/foo3"
deleteDir' "inputDir1/foo2/foo4"
deleteDir' "inputDir1/foo2"
deleteDir' "inputDir1"
normalDirPerms "outputDir1/foo2/foo4"
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
deleteFile' "outputDir1/foo2/foo4/inputFile6"
deleteDir' "outputDir1/foo2/foo4/inputFile4"
deleteDir' "outputDir1/foo2/foo4"
deleteDir' "outputDir1/foo2"
deleteDir' "outputDir1"
deleteFile' "alreadyExists"
deleteFile' "wrongInput"
deleteFile' "wrongInputSymL"
deleteDir' "alreadyExistsD"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
deleteFile' "inputDir/foo/inputFile1"
deleteFile' "inputDir/inputFile2"
deleteFile' "inputDir/bar/inputFile3"
deleteDir' "inputDir/foo"
deleteDir' "inputDir/bar"
deleteDir' "inputDir"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir"
"outputDir"
Strict
CollectFailures
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
-- posix failures --
it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $
copyDirRecursive' "doesNotExist"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $
copyDirRecursive' "noPerms/inputDir"
"foo"
Strict
CollectFailures
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures
it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do
copyDirRecursive' "inputDir1/foo2"
"outputDir1/foo2"
Overwrite
CollectFailures
`shouldThrow`
(\(RecursiveFailure ex@[_, _]) ->
any (\(h, e) -> ioeGetErrorType e == InappropriateType
&& isCopyFileFailed h) ex &&
any (\(h, e) -> ioeGetErrorType e == PermissionDenied
&& isReadContentsFailed h) ex)
normalDirPerms "outputDir1/foo2/foo4"
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
c <- allDirectoryContents' "outputDir1"
tmpDir' <- getRawTmpDir
let shouldC = (fmap (\x -> tmpDir' `BS.append` x)
["outputDir1"
,"outputDir1/foo2"
,"outputDir1/foo2/inputFile1"
,"outputDir1/foo2/inputFile2"
,"outputDir1/foo2/inputFile3"
,"outputDir1/foo2/foo4"
,"outputDir1/foo2/foo4/inputFile6"
,"outputDir1/foo2/foo4/inputFile4"])
deleteFile' "outputDir1/foo2/inputFile1"
deleteFile' "outputDir1/foo2/inputFile2"
deleteFile' "outputDir1/foo2/inputFile3"
sort c `shouldBe` sort shouldC
it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $
copyDirRecursive' "inputDir"
"alreadyExistsD"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument)
it "copyDirRecursive (Strict, CollectFailures), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Strict
CollectFailures
`shouldThrow`
isDestinationInSource
it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Strict
CollectFailures
`shouldThrow`
isSameFile

View File

@@ -5,6 +5,7 @@ module HPath.IO.CopyDirRecursiveOverwriteSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -17,11 +18,16 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import qualified Data.ByteString as BS import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveOverwriteSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "alreadyExists" createRegularFile' "alreadyExists"
@@ -81,89 +87,116 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyDirRecursiveOverwrite" $ do describe "HPath.IO.copyDirRecursive" $ do
-- successes -- -- successes --
it "copyDirRecursiveOverwrite, all fine" $ do it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do
copyDirRecursiveOverwrite' "inputDir" copyDirRecursive' "inputDir"
"outputDir" "outputDir"
Overwrite
FailEarly
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursiveOverwrite, all fine and compare" $ do it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do
copyDirRecursiveOverwrite' "inputDir" tmpDir' <- getRawTmpDir
"outputDir" copyDirRecursive' "inputDir"
"outputDir"
Overwrite
FailEarly
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " " ++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir ++ "outputDir") ++ toString tmpDir' ++ "outputDir")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursiveOverwrite, destination dir already exists" $ do it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do
tmpDir' <- getRawTmpDir
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " " ++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir ++ "alreadyExistsD") ++ toString tmpDir' ++ "alreadyExistsD")
`shouldReturn` (ExitFailure 1) `shouldReturn` (ExitFailure 1)
copyDirRecursiveOverwrite' "inputDir" copyDirRecursive' "inputDir"
"alreadyExistsD" "alreadyExistsD"
Overwrite
FailEarly
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " " ++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir ++ "alreadyExistsD") ++ toString tmpDir' ++ "alreadyExistsD")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
-- posix failures -- -- posix failures --
it "copyDirRecursiveOverwrite, source directory does not exist" $ it "copyDirRecursive, source directory does not exist" $
copyDirRecursiveOverwrite' "doesNotExist" copyDirRecursive' "doesNotExist"
"outputDir" "outputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursiveOverwrite, no write permission on output dir" $ it "copyDirRecursive, no write permission on output dir" $
copyDirRecursiveOverwrite' "inputDir" copyDirRecursive' "inputDir"
"noWritePerm/foo" "noWritePerm/foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open output dir" $ it "copyDirRecursive, cannot open output dir" $
copyDirRecursiveOverwrite' "inputDir" copyDirRecursive' "inputDir"
"noPerms/foo" "noPerms/foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open source dir" $ it "copyDirRecursive, cannot open source dir" $
copyDirRecursiveOverwrite' "noPerms/inputDir" copyDirRecursive' "noPerms/inputDir"
"foo" "foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, destination already exists and is a file" $ it "copyDirRecursive, destination already exists and is a file" $
copyDirRecursiveOverwrite' "inputDir" copyDirRecursive' "inputDir"
"alreadyExists" "alreadyExists"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (regular file)" $ it "copyDirRecursive, wrong input (regular file)" $
copyDirRecursiveOverwrite' "wrongInput" copyDirRecursive' "wrongInput"
"outputDir" "outputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $ it "copyDirRecursive, wrong input (symlink to directory)" $
copyDirRecursiveOverwrite' "wrongInputSymL" copyDirRecursive' "wrongInputSymL"
"outputDir" "outputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures -- custom failures
it "copyDirRecursiveOverwrite, destination in source" $ it "copyDirRecursive (Overwrite, FailEarly), destination in source" $
copyDirRecursiveOverwrite' "inputDir" copyDirRecursive' "inputDir"
"inputDir/foo" "inputDir/foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
isDestinationInSource isDestinationInSource
it "copyDirRecursiveOverwrite, destination and source same directory" $ it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $
copyDirRecursiveOverwrite' "inputDir" copyDirRecursive' "inputDir"
"inputDir" "inputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -5,6 +5,7 @@ module HPath.IO.CopyDirRecursiveSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -17,12 +18,14 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import qualified Data.ByteString as BS import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
@@ -69,82 +72,109 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do describe "HPath.IO.copyDirRecursive" $ do
-- successes -- -- successes --
it "copyDirRecursive, all fine" $ do it "copyDirRecursive (Strict, FailEarly), all fine" $ do
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"outputDir" "outputDir"
Strict
FailEarly
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursive, all fine and compare" $ do it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"outputDir" "outputDir"
Strict
FailEarly
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " " ++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir ++ "outputDir") ++ toString tmpDir' ++ "outputDir")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
-- posix failures -- -- posix failures --
it "copyDirRecursive, source directory does not exist" $ it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $
copyDirRecursive' "doesNotExist" copyDirRecursive' "doesNotExist"
"outputDir" "outputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive, no write permission on output dir" $ it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"noWritePerm/foo" "noWritePerm/foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open output dir" $ it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"noPerms/foo" "noPerms/foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open source dir" $ it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $
copyDirRecursive' "noPerms/inputDir" copyDirRecursive' "noPerms/inputDir"
"foo" "foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, destination dir already exists" $ it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"alreadyExistsD" "alreadyExistsD"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, destination already exists and is a file" $ it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"alreadyExists" "alreadyExists"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, wrong input (regular file)" $ it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $
copyDirRecursive' "wrongInput" copyDirRecursive' "wrongInput"
"outputDir" "outputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (symlink to directory)" $ it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL" copyDirRecursive' "wrongInputSymL"
"outputDir" "outputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures -- custom failures
it "copyDirRecursive, destination in source" $ it "copyDirRecursive (Strict, FailEarly), destination in source" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"inputDir/foo" "inputDir/foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
isDestinationInSource isDestinationInSource
it "copyDirRecursive, destination and source same directory" $ it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"inputDir" "inputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -4,6 +4,7 @@ module HPath.IO.CopyFileOverwriteSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -16,8 +17,14 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import qualified Data.ByteString as BS import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileOverwriteSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -51,79 +58,91 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyFileOverwrite" $ do describe "HPath.IO.copyFile" $ do
-- successes -- -- successes --
it "copyFileOverwrite, everything clear" $ do it "copyFile (Overwrite), everything clear" $ do
copyFileOverwrite' "inputFile" copyFile' "inputFile"
"outputFile" "outputFile"
Overwrite
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
it "copyFileOverwrite, output file already exists, all clear" $ do it "copyFile (Overwrite), output file already exists, all clear" $ do
copyFile' "alreadyExists" "alreadyExists.bak" tmpDir' <- getRawTmpDir
copyFileOverwrite' "inputFile" copyFile' "alreadyExists" "alreadyExists.bak" Strict
"alreadyExists" copyFile' "inputFile" "alreadyExists" Overwrite
(system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir ++ "alreadyExists") ++ toString tmpDir' ++ "alreadyExists")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists "alreadyExists" removeFileIfExists "alreadyExists"
copyFile' "alreadyExists.bak" "alreadyExists" copyFile' "alreadyExists.bak" "alreadyExists" Strict
removeFileIfExists "alreadyExists.bak" removeFileIfExists "alreadyExists.bak"
it "copyFileOverwrite, and compare" $ do it "copyFile (Overwrite), and compare" $ do
copyFileOverwrite' "inputFile" tmpDir' <- getRawTmpDir
copyFile' "inputFile"
"outputFile" "outputFile"
(system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " Overwrite
++ toString tmpDir ++ "outputFile") (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "outputFile")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
-- posix failures -- -- posix failures --
it "copyFileOverwrite, input file does not exist" $ it "copyFile (Overwrite), input file does not exist" $
copyFileOverwrite' "noSuchFile" copyFile' "noSuchFile"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyFileOverwrite, no permission to write to output directory" $ it "copyFile (Overwrite), no permission to write to output directory" $
copyFileOverwrite' "inputFile" copyFile' "inputFile"
"outputDirNoWrite/outputFile" "outputDirNoWrite/outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open output directory" $ it "copyFile (Overwrite), cannot open output directory" $
copyFileOverwrite' "inputFile" copyFile' "inputFile"
"noPerms/outputFile" "noPerms/outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open source directory" $ it "copyFile (Overwrite), cannot open source directory" $
copyFileOverwrite' "noPerms/inputFile" copyFile' "noPerms/inputFile"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, wrong input type (symlink)" $ it "copyFile (Overwrite), wrong input type (symlink)" $
copyFileOverwrite' "inputFileSymL" copyFile' "inputFileSymL"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "copyFileOverwrite, wrong input type (directory)" $ it "copyFile (Overwrite), wrong input type (directory)" $
copyFileOverwrite' "wrongInput" copyFile' "wrongInput"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyFileOverwrite, output file already exists and is a dir" $ it "copyFile (Overwrite), output file already exists and is a dir" $
copyFileOverwrite' "inputFile" copyFile' "inputFile"
"alreadyExistsD" "alreadyExistsD"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
-- custom failures -- -- custom failures --
it "copyFileOverwrite, output and input are same file" $ it "copyFile (Overwrite), output and input are same file" $
copyFileOverwrite' "inputFile" copyFile' "inputFile"
"inputFile" "inputFile"
Overwrite
`shouldThrow` isSameFile `shouldThrow` isSameFile

View File

@@ -5,6 +5,7 @@ module HPath.IO.CopyFileSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -17,10 +18,15 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import qualified Data.ByteString as BS import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "inputFile" createRegularFile' "inputFile"
@@ -51,75 +57,87 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyFile" $ do describe "HPath.IO.copyFile" $ do
-- successes -- -- successes --
it "copyFile, everything clear" $ do it "copyFile (Strict), everything clear" $ do
copyFile' "inputFile" copyFile' "inputFile"
"outputFile" "outputFile"
Strict
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
it "copyFile, and compare" $ do it "copyFile (Strict), and compare" $ do
tmpDir' <- getRawTmpDir
copyFile' "inputFile" copyFile' "inputFile"
"outputFile" "outputFile"
(system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " " Strict
++ toString tmpDir ++ "outputFile") (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "outputFile")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
-- posix failures -- -- posix failures --
it "copyFile, input file does not exist" $ it "copyFile (Strict), input file does not exist" $
copyFile' "noSuchFile" copyFile' "noSuchFile"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile, no permission to write to output directory" $ it "copyFile (Strict), no permission to write to output directory" $
copyFile' "inputFile" copyFile' "inputFile"
"outputDirNoWrite/outputFile" "outputDirNoWrite/outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open output directory" $ it "copyFile (Strict), cannot open output directory" $
copyFile' "inputFile" copyFile' "inputFile"
"noPerms/outputFile" "noPerms/outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open source directory" $ it "copyFile (Strict), cannot open source directory" $
copyFile' "noPerms/inputFile" copyFile' "noPerms/inputFile"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, wrong input type (symlink)" $ it "copyFile (Strict), wrong input type (symlink)" $
copyFile' "inputFileSymL" copyFile' "inputFileSymL"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile, wrong input type (directory)" $ it "copyFile (Strict), wrong input type (directory)" $
copyFile' "wrongInput" copyFile' "wrongInput"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyFile, output file already exists" $ it "copyFile (Strict), output file already exists" $
copyFile' "inputFile" copyFile' "inputFile"
"alreadyExists" "alreadyExists"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyFile, output file already exists and is a dir" $ it "copyFile (Strict), output file already exists and is a dir" $
copyFile' "inputFile" copyFile' "inputFile"
"alreadyExistsD" "alreadyExistsD"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures -- -- custom failures --
it "copyFile, output and input are same file" $ it "copyFile (Strict), output and input are same file" $
copyFile' "inputFile" copyFile' "inputFile"
"inputFile" "inputFile"
Strict
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -0,0 +1,78 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CreateDirRecursiveSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirRecursiveSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createDir' "alreadyExists"
createRegularFile' "alreadyExistsF"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteDir' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
deleteFile' "alreadyExistsF"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.createDirRecursive" $ do
-- successes --
it "createDirRecursive, all fine" $ do
createDirRecursive' "newDir"
deleteDir' "newDir"
it "createDirRecursive, parent directories do not exist" $ do
createDirRecursive' "some/thing/dada"
deleteDir' "some/thing/dada"
deleteDir' "some/thing"
deleteDir' "some"
it "createDirRecursive, destination directory already exists" $
createDirRecursive' "alreadyExists"
-- posix failures --
it "createDirRecursive, destination already exists and is a file" $
createDirRecursive' "alreadyExistsF"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "createDirRecursive, can't write to output directory" $
createDirRecursive' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDirRecursive, can't open output directory" $
createDirRecursive' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -13,10 +13,14 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createDir' "alreadyExists" createDir' "alreadyExists"
@@ -37,7 +41,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.createDir" $ do describe "HPath.IO.createDir" $ do
-- successes -- -- successes --
@@ -46,6 +50,11 @@ spec = before_ setupFiles $ after_ cleanupFiles $
removeDirIfExists "newDir" removeDirIfExists "newDir"
-- posix failures -- -- posix failures --
it "createDir, parent directories do not exist" $
createDir' "some/thing/dada"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createDir, can't write to output directory" $ it "createDir, can't write to output directory" $
createDir' "noWritePerms/newDir" createDir' "noWritePerms/newDir"
`shouldThrow` `shouldThrow`

View File

@@ -13,10 +13,14 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateRegularFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "alreadyExists" createRegularFile' "alreadyExists"
@@ -25,8 +29,6 @@ setupFiles = do
noPerms "noPerms" noPerms "noPerms"
noWritableDirPerms "noWritePerms" noWritableDirPerms "noWritePerms"
cleanupFiles :: IO () cleanupFiles :: IO ()
cleanupFiles = do cleanupFiles = do
normalDirPerms "noPerms" normalDirPerms "noPerms"
@@ -37,7 +39,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.createRegularFile" $ do describe "HPath.IO.createRegularFile" $ do
-- successes -- -- successes --
@@ -46,6 +48,11 @@ spec = before_ setupFiles $ after_ cleanupFiles $
removeFileIfExists "newDir" removeFileIfExists "newDir"
-- posix failures -- -- posix failures --
it "createRegularFile, parent directories do not exist" $
createRegularFile' "some/thing/dada"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createRegularFile, can't write to destination directory" $ it "createRegularFile, can't write to destination directory" $
createRegularFile' "noWritePerms/newDir" createRegularFile' "noWritePerms/newDir"
`shouldThrow` `shouldThrow`

View File

@@ -4,7 +4,6 @@ module HPath.IO.CreateSymlinkSpec where
import Test.Hspec import Test.Hspec
import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
ioeGetErrorType ioeGetErrorType
@@ -14,8 +13,12 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateSymlinkSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -37,7 +40,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.createSymlink" $ do describe "HPath.IO.createSymlink" $ do
-- successes -- -- successes --
@@ -46,6 +49,11 @@ spec = before_ setupFiles $ after_ cleanupFiles $
removeFileIfExists "newSymL" removeFileIfExists "newSymL"
-- posix failures -- -- posix failures --
it "createSymlink, parent directories do not exist" $
createSymlink' "some/thing/dada" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createSymlink, can't write to destination directory" $ it "createSymlink, can't write to destination directory" $
createSymlink' "noWritePerms/newDir" "lala" createSymlink' "noWritePerms/newDir" "lala"
`shouldThrow` `shouldThrow`

View File

@@ -17,8 +17,13 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteDirRecursiveSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -46,7 +51,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.deleteDirRecursive" $ do describe "HPath.IO.deleteDirRecursive" $ do
-- successes -- -- successes --

View File

@@ -17,8 +17,14 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteDirSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -46,7 +52,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.deleteDir" $ do describe "HPath.IO.deleteDir" $ do
-- successes -- -- successes --

View File

@@ -4,6 +4,7 @@ module HPath.IO.DeleteFileSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import System.IO.Error import System.IO.Error
( (
ioeGetErrorType ioeGetErrorType
@@ -17,8 +18,12 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -41,7 +46,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.deleteFile" $ do describe "HPath.IO.deleteFile" $ do
-- successes -- -- successes --
@@ -55,6 +60,7 @@ spec = before_ setupFiles $ after_ cleanupFiles $
it "deleteFile, symlink, all fine" $ do it "deleteFile, symlink, all fine" $ do
recreateSymlink' "syml" recreateSymlink' "syml"
"testFile" "testFile"
Strict
deleteFile' "testFile" deleteFile' "testFile"
getSymbolicLinkStatus "testFile" getSymbolicLinkStatus "testFile"
`shouldThrow` `shouldThrow`

View File

@@ -3,18 +3,10 @@
module HPath.IO.GetDirsFilesSpec where module HPath.IO.GetDirsFilesSpec where
import Control.Applicative
(
(<$>)
)
import Data.List import Data.List
( (
sort sort
) )
import Data.Maybe
(
fromJust
)
import qualified HPath as P import qualified HPath as P
import HPath.IO import HPath.IO
import Test.Hspec import Test.Hspec
@@ -22,17 +14,17 @@ import System.IO.Error
( (
ioeGetErrorType ioeGetErrorType
) )
import System.Posix.Env.ByteString
(
getEnv
)
import GHC.IO.Exception import GHC.IO.Exception
( (
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "GetDirsFilesSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -61,7 +53,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.getDirsFiles" $ do describe "HPath.IO.getDirsFiles" $ do
-- successes -- -- successes --

View File

@@ -14,8 +14,13 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "GetFileTypeSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -42,7 +47,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.getFileType" $ do describe "HPath.IO.getFileType" $ do
-- successes -- -- successes --

View File

@@ -4,6 +4,7 @@ module HPath.IO.MoveFileOverwriteSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -14,8 +15,13 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "MoveFileOverwriteSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -45,65 +51,76 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.moveFileOverwrite" $ do describe "HPath.IO.moveFile" $ do
-- successes -- -- successes --
it "moveFileOverwrite, all fine" $ it "moveFile (Overwrite), all fine" $
moveFileOverwrite' "myFile" moveFile' "myFile"
"movedFile" "movedFile"
Overwrite
it "moveFileOverwrite, all fine" $ it "moveFile (Overwrite), all fine" $
moveFileOverwrite' "myFile" moveFile' "myFile"
"dir/movedFile" "dir/movedFile"
Overwrite
it "moveFileOverwrite, all fine on symlink" $ it "moveFile (Overwrite), all fine on symlink" $
moveFileOverwrite' "myFileL" moveFile' "myFileL"
"movedFile" "movedFile"
Overwrite
it "moveFileOverwrite, all fine on directory" $ it "moveFile (Overwrite), all fine on directory" $
moveFileOverwrite' "dir" moveFile' "dir"
"movedFile" "movedFile"
Overwrite
it "moveFileOverwrite, destination file already exists" $ it "moveFile (Overwrite), destination file already exists" $
moveFileOverwrite' "myFile" moveFile' "myFile"
"alreadyExists" "alreadyExists"
Overwrite
-- posix failures -- -- posix failures --
it "moveFileOverwrite, source file does not exist" $ it "moveFile (Overwrite), source file does not exist" $
moveFileOverwrite' "fileDoesNotExist" moveFile' "fileDoesNotExist"
"movedFile" "movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "moveFileOverwrite, can't write to destination directory" $ it "moveFile (Overwrite), can't write to destination directory" $
moveFileOverwrite' "myFile" moveFile' "myFile"
"noWritePerm/movedFile" "noWritePerm/movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open destination directory" $ it "moveFile (Overwrite), can't open destination directory" $
moveFileOverwrite' "myFile" moveFile' "myFile"
"noPerms/movedFile" "noPerms/movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open source directory" $ it "moveFile (Overwrite), can't open source directory" $
moveFileOverwrite' "noPerms/myFile" moveFile' "noPerms/myFile"
"movedFile" "movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures -- -- custom failures --
it "moveFileOverwrite, move from file to dir" $
moveFileOverwrite' "myFile"
"alreadyExistsD"
`shouldThrow`
isDirDoesExist
it "moveFileOverwrite, source and dest are same file" $ it "moveFile (Overwrite), move from file to dir" $
moveFileOverwrite' "myFile" moveFile' "myFile"
"myFile" "alreadyExistsD"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "moveFile (Overwrite), source and dest are same file" $
moveFile' "myFile"
"myFile"
Overwrite
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -4,6 +4,7 @@ module HPath.IO.MoveFileSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -14,8 +15,13 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "MoveFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -47,67 +53,77 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.moveFile" $ do describe "HPath.IO.moveFile" $ do
-- successes -- -- successes --
it "moveFile, all fine" $ it "moveFile (Strict), all fine" $
moveFile' "myFile" moveFile' "myFile"
"movedFile" "movedFile"
Strict
it "moveFile, all fine" $ it "moveFile (Strict), all fine" $
moveFile' "myFile" moveFile' "myFile"
"dir/movedFile" "dir/movedFile"
Strict
it "moveFile, all fine on symlink" $ it "moveFile (Strict), all fine on symlink" $
moveFile' "myFileL" moveFile' "myFileL"
"movedFile" "movedFile"
Strict
it "moveFile, all fine on directory" $ it "moveFile (Strict), all fine on directory" $
moveFile' "dir" moveFile' "dir"
"movedFile" "movedFile"
Strict
-- posix failures -- -- posix failures --
it "moveFile, source file does not exist" $ it "moveFile (Strict), source file does not exist" $
moveFile' "fileDoesNotExist" moveFile' "fileDoesNotExist"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile, can't write to destination directory" $ it "moveFile (Strict), can't write to destination directory" $
moveFile' "myFile" moveFile' "myFile"
"noWritePerm/movedFile" "noWritePerm/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open destination directory" $ it "moveFile (Strict), can't open destination directory" $
moveFile' "myFile" moveFile' "myFile"
"noPerms/movedFile" "noPerms/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open source directory" $ it "moveFile (Strict), can't open source directory" $
moveFile' "noPerms/myFile" moveFile' "noPerms/myFile"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures -- -- custom failures --
it "moveFile, destination file already exists" $ it "moveFile (Strict), destination file already exists" $
moveFile' "myFile" moveFile' "myFile"
"alreadyExists" "alreadyExists"
Strict
`shouldThrow` `shouldThrow`
isFileDoesExist (\e -> ioeGetErrorType e == AlreadyExists)
it "moveFile, move from file to dir" $ it "moveFile (Strict), move from file to dir" $
moveFile' "myFile" moveFile' "myFile"
"alreadyExistsD" "alreadyExistsD"
Strict
`shouldThrow` `shouldThrow`
isDirDoesExist (\e -> ioeGetErrorType e == AlreadyExists)
it "moveFile, source and dest are same file" $ it "moveFile (Strict), source and dest are same file" $
moveFile' "myFile" moveFile' "myFile"
"myFile" "myFile"
Strict
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -0,0 +1,85 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.ReadFileEOFSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "ReadFileEOFSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.readFileEOF" $ do
-- successes --
it "readFileEOF (Strict) file with content, everything clear" $ do
out <- readFileEOF' "fileWithContent"
out `shouldBe` "Blahfaselgagaga"
it "readFileEOF (Strict) symlink, everything clear" $ do
out <- readFileEOF' "inputFileSymL"
out `shouldBe` "Blahfaselgagaga"
it "readFileEOF (Strict) empty file, everything clear" $ do
out <- readFileEOF' "fileWithoutContent"
out `shouldBe` ""
-- posix failures --
it "readFileEOF (Strict) directory, wrong file type" $ do
readFileEOF' "alreadyExistsD"
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "readFileEOF (Strict) file, no permissions" $ do
readFileEOF' "noPerms"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFileEOF (Strict) file, no permissions on dir" $ do
readFileEOF' "noPermsD/inputFile"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFileEOF (Strict) file, no such file" $ do
readFileEOF' "lalala"
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -0,0 +1,85 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.ReadFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "ReadFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.readFile" $ do
-- successes --
it "readFile (Strict) file with content, everything clear" $ do
out <- readFile' "fileWithContent"
out `shouldBe` "Blahfaselgagaga"
it "readFile (Strict) symlink, everything clear" $ do
out <- readFile' "inputFileSymL"
out `shouldBe` "Blahfaselgagaga"
it "readFile (Strict) empty file, everything clear" $ do
out <- readFile' "fileWithoutContent"
out `shouldBe` ""
-- posix failures --
it "readFile (Strict) directory, wrong file type" $ do
readFile' "alreadyExistsD"
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "readFile (Strict) file, no permissions" $ do
readFile' "noPerms"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFile (Strict) file, no permissions on dir" $ do
readFile' "noPermsD/inputFile"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFile (Strict) file, no such file" $ do
readFile' "lalala"
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -0,0 +1,139 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.RecreateSymlinkOverwriteSpec where
-- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RecreateSymlinkOverwriteSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
createDir' "alreadyExistsD2"
createRegularFile' "alreadyExistsD2/lala"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteFile' "alreadyExistsD2/lala"
deleteDir' "alreadyExistsD"
deleteDir' "alreadyExistsD2"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.recreateSymlink" $ do
-- successes --
it "recreateSymLink (Overwrite), all fine" $ do
recreateSymlink' "myFileL"
"movedFile"
Overwrite
removeFileIfExists "movedFile"
it "recreateSymLink (Overwrite), all fine" $ do
recreateSymlink' "myFileL"
"dir/movedFile"
Overwrite
removeFileIfExists "dir/movedFile"
it "recreateSymLink (Overwrite), destination file already exists" $
recreateSymlink' "myFileL"
"alreadyExists"
Overwrite
it "recreateSymLink (Overwrite), destination already exists and is an empty dir" $ do
recreateSymlink' "myFileL"
"alreadyExistsD"
Overwrite
deleteFile' "alreadyExistsD"
createDir' "alreadyExistsD"
-- posix failures --
it "recreateSymLink (Overwrite), destination already exists and is a non-empty dir" $
recreateSymlink' "myFileL"
"alreadyExistsD2"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
it "recreateSymLink (Overwrite), wrong input type (file)" $
recreateSymlink' "myFile"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Overwrite), wrong input type (directory)" $
recreateSymlink' "dir"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Overwrite), can't write to destination directory" $
recreateSymlink' "myFileL"
"noWritePerm/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Overwrite), can't open destination directory" $
recreateSymlink' "myFileL"
"noPerms/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Overwrite), can't open source directory" $
recreateSymlink' "noPerms/myFileL"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "recreateSymLink (Overwrite), source and destination are the same file" $
recreateSymlink' "myFileL"
"myFileL"
Overwrite
`shouldThrow`
isSameFile

View File

@@ -3,7 +3,10 @@
module HPath.IO.RecreateSymlinkSpec where module HPath.IO.RecreateSymlinkSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -14,8 +17,13 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RecreateSymlinkSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -46,67 +54,77 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.recreateSymlink" $ do describe "HPath.IO.recreateSymlink" $ do
-- successes -- -- successes --
it "recreateSymLink, all fine" $ do it "recreateSymLink (Strict), all fine" $ do
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"movedFile" "movedFile"
Strict
removeFileIfExists "movedFile" removeFileIfExists "movedFile"
it "recreateSymLink, all fine" $ do it "recreateSymLink (Strict), all fine" $ do
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"dir/movedFile" "dir/movedFile"
Strict
removeFileIfExists "dir/movedFile" removeFileIfExists "dir/movedFile"
-- posix failures -- -- posix failures --
it "recreateSymLink, wrong input type (file)" $ it "recreateSymLink (Strict), wrong input type (file)" $
recreateSymlink' "myFile" recreateSymlink' "myFile"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, wrong input type (directory)" $ it "recreateSymLink (Strict), wrong input type (directory)" $
recreateSymlink' "dir" recreateSymlink' "dir"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, can't write to destination directory" $ it "recreateSymLink (Strict), can't write to destination directory" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"noWritePerm/movedFile" "noWritePerm/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open destination directory" $ it "recreateSymLink (Strict), can't open destination directory" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"noPerms/movedFile" "noPerms/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open source directory" $ it "recreateSymLink (Strict), can't open source directory" $
recreateSymlink' "noPerms/myFileL" recreateSymlink' "noPerms/myFileL"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, destination file already exists" $ it "recreateSymLink (Strict), destination file already exists" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"alreadyExists" "alreadyExists"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "recreateSymLink, destination already exists and is a dir" $ it "recreateSymLink (Strict), destination already exists and is a dir" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"alreadyExistsD" "alreadyExistsD"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures -- -- custom failures --
it "recreateSymLink, source and destination are the same file" $ it "recreateSymLink (Strict), source and destination are the same file" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"myFileL" "myFileL"
Strict
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -14,8 +14,13 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RenameFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -46,7 +51,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.renameFile" $ do describe "HPath.IO.renameFile" $ do
-- successes -- -- successes --
@@ -96,13 +101,13 @@ spec = before_ setupFiles $ after_ cleanupFiles $
renameFile' "myFile" renameFile' "myFile"
"alreadyExists" "alreadyExists"
`shouldThrow` `shouldThrow`
isFileDoesExist (\e -> ioeGetErrorType e == AlreadyExists)
it "renameFile, move from file to dir" $ it "renameFile, move from file to dir" $
renameFile' "myFile" renameFile' "myFile"
"alreadyExistsD" "alreadyExistsD"
`shouldThrow` `shouldThrow`
isDirDoesExist (\e -> ioeGetErrorType e == AlreadyExists)
it "renameFile, source and dest are same file" $ it "renameFile, source and dest are same file" $
renameFile' "myFile" renameFile' "myFile"

View File

@@ -0,0 +1,27 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.ToAbsSpec where
import Test.Hspec
import HPath
import HPath.IO
spec :: Spec
spec = describe "HPath.IO.toAbs" $ do
-- successes --
it "toAbs returns absolute paths unchanged" $ do
p1 <- parseAbs "/a/b/c/d"
to <- toAbs p1
p1 `shouldBe` to
it "toAbs returns even existing absolute paths unchanged" $ do
p1 <- parseAbs "/home"
to <- toAbs p1
p1 `shouldBe` to

View File

@@ -0,0 +1,108 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.WriteFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "WriteFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.writeFile" $ do
-- successes --
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "blahfaselllll"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "gagagaga"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` ""
it "writeFile file without content, everything clear" $ do
writeFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "writeFile, everything clear" $ do
writeFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "gagagaga"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "blahfaselllll"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "gagagaga"
-- posix failures --
it "writeFile to dir, inappropriate type" $ do
writeFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "writeFile, no permissions to file" $ do
writeFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, no permissions to file" $ do
writeFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, file does not exist" $ do
writeFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -14,10 +14,6 @@ main :: IO ()
main = main =
hspecWith hspecWith
defaultConfig { configFormatter = Just progress } defaultConfig { configFormatter = Just progress }
$ before_ up $ beforeAll_ createBaseTmpDir
$ after_ down $ afterAll_ deleteBaseTmpDir
$ Spec.spec $ Spec.spec
where
up = createTmpDir
down = deleteTmpDir

View File

@@ -11,16 +11,34 @@ import Control.Applicative
) )
import Control.Monad import Control.Monad
( (
void forM_
, void
)
import Control.Monad.IfElse
(
whenM
)
import qualified Data.ByteString as BS
import Data.IORef
(
newIORef
, readIORef
, writeIORef
, IORef
) )
import HPath.IO import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import HPath.IO.Utils import Prelude hiding (appendFile, readFile, writeFile)
import Data.Maybe import Data.Maybe
( (
fromJust fromJust
) )
import qualified HPath as P import qualified HPath as P
import System.IO.Unsafe
(
unsafePerformIO
)
import qualified System.Posix.Directory.Traversals as DT
import System.Posix.Env.ByteString import System.Posix.Env.ByteString
( (
getEnv getEnv
@@ -29,6 +47,7 @@ import Data.ByteString
( (
ByteString ByteString
) )
import qualified Data.ByteString.Lazy as L
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
( (
groupExecuteMode groupExecuteMode
@@ -42,13 +61,15 @@ import System.Posix.Files.ByteString
, unionFileModes , unionFileModes
) )
import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
baseTmpDir :: ByteString
baseTmpDir = "test/HPath/IO/tmp/"
tmpDir :: ByteString
tmpDir = "test/HPath/IO/tmp/" tmpDir :: IORef ByteString
{-# NOINLINE tmpDir #-}
tmpDir = unsafePerformIO (newIORef baseTmpDir)
@@ -57,31 +78,63 @@ tmpDir = "test/HPath/IO/tmp/"
----------------- -----------------
setTmpDir :: ByteString -> IO ()
{-# NOINLINE setTmpDir #-}
setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs)
createTmpDir :: IO () createTmpDir :: IO ()
{-# NOINLINE createTmpDir #-}
createTmpDir = do createTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir tmp <- P.parseRel =<< readIORef tmpDir
void $ createDir (pwd P.</> tmp) void $ createDir newDirPerms (pwd P.</> tmp)
deleteTmpDir :: IO () deleteTmpDir :: IO ()
{-# NOINLINE deleteTmpDir #-}
deleteTmpDir = do deleteTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir tmp <- P.parseRel =<< readIORef tmpDir
void $ deleteDir (pwd P.</> tmp)
createBaseTmpDir :: IO ()
{-# NOINLINE createBaseTmpDir #-}
createBaseTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel baseTmpDir
void $ createDir newDirPerms (pwd P.</> tmp)
deleteBaseTmpDir :: IO ()
{-# NOINLINE deleteBaseTmpDir #-}
deleteBaseTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel baseTmpDir
contents <- getDirsFiles (pwd P.</> tmp)
forM_ contents deleteDir
void $ deleteDir (pwd P.</> tmp) void $ deleteDir (pwd P.</> tmp)
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a
{-# NOINLINE withRawTmpDir #-}
withRawTmpDir f = do withRawTmpDir f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir tmp <- P.parseRel =<< readIORef tmpDir
f (pwd P.</> tmp) f (pwd P.</> tmp)
getRawTmpDir :: IO ByteString
{-# NOINLINE getRawTmpDir #-}
getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs)
withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
{-# NOINLINE withTmpDir #-}
withTmpDir ip f = do withTmpDir ip f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir tmp <- P.parseRel =<< readIORef tmpDir
p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip
f p f p
@@ -90,84 +143,83 @@ withTmpDir' :: ByteString
-> ByteString -> ByteString
-> (P.Path P.Abs -> P.Path P.Abs -> IO a) -> (P.Path P.Abs -> P.Path P.Abs -> IO a)
-> IO a -> IO a
{-# NOINLINE withTmpDir' #-}
withTmpDir' ip1 ip2 f = do withTmpDir' ip1 ip2 f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir tmp <- P.parseRel =<< readIORef tmpDir
p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1 p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1
p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2 p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2
f p1 p2 f p1 p2
removeFileIfExists :: ByteString -> IO () removeFileIfExists :: ByteString -> IO ()
{-# NOINLINE removeFileIfExists #-}
removeFileIfExists bs = removeFileIfExists bs =
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)
removeDirIfExists :: ByteString -> IO () removeDirIfExists :: ByteString -> IO ()
{-# NOINLINE removeDirIfExists #-}
removeDirIfExists bs = removeDirIfExists bs =
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
copyFile' :: ByteString -> ByteString -> IO () copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()
copyFile' inputFileP outputFileP = {-# NOINLINE copyFile' #-}
withTmpDir' inputFileP outputFileP copyFile copyFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)
copyFileOverwrite' :: ByteString -> ByteString -> IO () copyDirRecursive' :: ByteString -> ByteString
copyFileOverwrite' inputFileP outputFileP = -> CopyMode -> RecursiveErrorMode -> IO ()
withTmpDir' inputFileP outputFileP copyFileOverwrite {-# NOINLINE copyDirRecursive' #-}
copyDirRecursive' inputDirP outputDirP cm rm =
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)
copyDirRecursive' :: ByteString -> ByteString -> IO ()
copyDirRecursive' inputDirP outputDirP =
withTmpDir' inputDirP outputDirP copyDirRecursive
copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO ()
copyDirRecursiveOverwrite' inputDirP outputDirP =
withTmpDir' inputDirP outputDirP copyDirRecursiveOverwrite
createDir' :: ByteString -> IO () createDir' :: ByteString -> IO ()
createDir' dest = withTmpDir dest createDir {-# NOINLINE createDir' #-}
createDir' dest = withTmpDir dest (createDir newDirPerms)
createDirRecursive' :: ByteString -> IO ()
{-# NOINLINE createDirRecursive' #-}
createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)
createRegularFile' :: ByteString -> IO () createRegularFile' :: ByteString -> IO ()
createRegularFile' dest = withTmpDir dest createRegularFile {-# NOINLINE createRegularFile' #-}
createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms)
createSymlink' :: ByteString -> ByteString -> IO () createSymlink' :: ByteString -> ByteString -> IO ()
{-# NOINLINE createSymlink' #-}
createSymlink' dest sympoint = withTmpDir dest createSymlink' dest sympoint = withTmpDir dest
(\x -> createSymlink x sympoint) (\x -> createSymlink x sympoint)
renameFile' :: ByteString -> ByteString -> IO () renameFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE renameFile' #-}
renameFile' inputFileP outputFileP = renameFile' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP $ \i o -> do withTmpDir' inputFileP outputFileP $ \i o -> do
renameFile i o renameFile i o
renameFile o i renameFile o i
moveFile' :: ByteString -> ByteString -> IO () moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()
moveFile' inputFileP outputFileP = {-# NOINLINE moveFile' #-}
moveFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP $ \i o -> do withTmpDir' inputFileP outputFileP $ \i o -> do
moveFile i o moveFile i o cm
moveFile o i moveFile o i Strict
moveFileOverwrite' :: ByteString -> ByteString -> IO () recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO ()
moveFileOverwrite' inputFileP outputFileP = {-# NOINLINE recreateSymlink' #-}
withTmpDir' inputFileP outputFileP $ \i o -> do recreateSymlink' inputFileP outputFileP cm =
moveFileOverwrite i o withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)
moveFile o i
recreateSymlink' :: ByteString -> ByteString -> IO ()
recreateSymlink' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP recreateSymlink
noWritableDirPerms :: ByteString -> IO () noWritableDirPerms :: ByteString -> IO ()
{-# NOINLINE noWritableDirPerms #-}
noWritableDirPerms path = withTmpDir path $ \p -> noWritableDirPerms path = withTmpDir path $ \p ->
setFileMode (P.fromAbs p) perms setFileMode (P.fromAbs p) perms
where where
@@ -180,42 +232,76 @@ noWritableDirPerms path = withTmpDir path $ \p ->
noPerms :: ByteString -> IO () noPerms :: ByteString -> IO ()
{-# NOINLINE noPerms #-}
noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode
normalDirPerms :: ByteString -> IO () normalDirPerms :: ByteString -> IO ()
{-# NOINLINE normalDirPerms #-}
normalDirPerms path = normalDirPerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms
normalFilePerms :: ByteString -> IO ()
{-# NOINLINE normalFilePerms #-}
normalFilePerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newFilePerms
getFileType' :: ByteString -> IO FileType getFileType' :: ByteString -> IO FileType
{-# NOINLINE getFileType' #-}
getFileType' path = withTmpDir path getFileType getFileType' path = withTmpDir path getFileType
getDirsFiles' :: ByteString -> IO [P.Path P.Abs] getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
{-# NOINLINE getDirsFiles' #-}
getDirsFiles' path = withTmpDir path getDirsFiles getDirsFiles' path = withTmpDir path getDirsFiles
deleteFile' :: ByteString -> IO () deleteFile' :: ByteString -> IO ()
{-# NOINLINE deleteFile' #-}
deleteFile' p = withTmpDir p deleteFile deleteFile' p = withTmpDir p deleteFile
deleteDir' :: ByteString -> IO () deleteDir' :: ByteString -> IO ()
{-# NOINLINE deleteDir' #-}
deleteDir' p = withTmpDir p deleteDir deleteDir' p = withTmpDir p deleteDir
deleteDirRecursive' :: ByteString -> IO () deleteDirRecursive' :: ByteString -> IO ()
{-# NOINLINE deleteDirRecursive' #-}
deleteDirRecursive' p = withTmpDir p deleteDirRecursive deleteDirRecursive' p = withTmpDir p deleteDirRecursive
canonicalizePath' :: ByteString -> IO (P.Path P.Abs) canonicalizePath' :: ByteString -> IO (P.Path P.Abs)
{-# NOINLINE canonicalizePath' #-}
canonicalizePath' p = withTmpDir p canonicalizePath canonicalizePath' p = withTmpDir p canonicalizePath
writeFile' :: ByteString -> ByteString -> IO () writeFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE writeFile' #-}
writeFile' ip bs = writeFile' ip bs =
withTmpDir ip $ \p -> do withTmpDir ip $ \p -> writeFile p bs
fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing
SPI.defaultFileFlags
SPB.fdWrite fd bs appendFile' :: ByteString -> ByteString -> IO ()
SPI.closeFd fd {-# NOINLINE appendFile' #-}
appendFile' ip bs =
withTmpDir ip $ \p -> appendFile p bs
allDirectoryContents' :: ByteString -> IO [ByteString]
{-# NOINLINE allDirectoryContents' #-}
allDirectoryContents' ip =
withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p)
readFile' :: ByteString -> IO ByteString
{-# NOINLINE readFile' #-}
readFile' p = withTmpDir p readFile
readFileEOF' :: ByteString -> IO L.ByteString
{-# NOINLINE readFileEOF' #-}
readFileEOF' p = withTmpDir p readFileEOF